6984a4b66aa04928859267b291caa2e9128d204c
[ghc.git] / compiler / rename / RnSource.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[RnSource]{Main pass of renamer}
5
6 \begin{code}
7 module RnSource ( 
8         rnSrcDecls, addTcgDUs, rnTyClDecls 
9     ) where
10
11 #include "HsVersions.h"
12
13 import {-# SOURCE #-} RnExpr( rnLExpr )
14
15 import HsSyn
16 import RdrName          ( RdrName, isRdrDataCon, elemLocalRdrEnv, rdrNameOcc )
17 import RdrHsSyn         ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
18 import RnHsSyn
19 import RnTypes          ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext, rnConDeclFields )
20 import RnBinds          ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
21                                 makeMiniFixityEnv)
22 import RnEnv            ( lookupLocalDataTcNames, lookupLocatedOccRn,
23                           lookupTopBndrRn, lookupLocatedTopBndrRn,
24                           lookupOccRn, newLocalBndrsRn, bindLocalNamesFV,
25                           bindLocatedLocalsFV, bindPatSigTyVarsFV,
26                           bindTyVarsRn, extendTyVarEnvFVRn,
27                           bindLocalNames, checkDupRdrNames, mapFvRn
28                         )
29 import RnNames          ( getLocalNonValBinders, extendGlobalRdrEnvRn )
30 import HscTypes         ( GenAvailInfo(..), availsToNameSet )
31 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
32 import TcRnMonad
33
34 import ForeignCall      ( CCallTarget(..) )
35 import Module
36 import HscTypes         ( Warnings(..), plusWarns )
37 import Class            ( FunDep )
38 import Name             ( Name, nameOccName )
39 import NameSet
40 import NameEnv
41 import Outputable
42 import Bag
43 import FastString
44 import Util             ( filterOut )
45 import SrcLoc
46 import DynFlags         ( DynFlag(..), DynFlags, thisPackage )
47 import HscTypes         ( HscEnv, hsc_dflags )
48 import BasicTypes       ( Boxity(..) )
49 import ListSetOps       ( findDupsEq )
50
51
52 import Control.Monad
53 import Data.Maybe
54 \end{code}
55
56 \begin{code}
57 -- XXX
58 thenM :: Monad a => a b -> (b -> a c) -> a c
59 thenM = (>>=)
60
61 thenM_ :: Monad a => a b -> a c -> a c
62 thenM_ = (>>)
63 \end{code}
64
65 @rnSourceDecl@ `renames' declarations.
66 It simultaneously performs dependency analysis and precedence parsing.
67 It also does the following error checks:
68 \begin{enumerate}
69 \item
70 Checks that tyvars are used properly. This includes checking
71 for undefined tyvars, and tyvars in contexts that are ambiguous.
72 (Some of this checking has now been moved to module @TcMonoType@,
73 since we don't have functional dependency information at this point.)
74 \item
75 Checks that all variable occurences are defined.
76 \item 
77 Checks the @(..)@ etc constraints in the export list.
78 \end{enumerate}
79
80
81 \begin{code}
82 -- Brings the binders of the group into scope in the appropriate places;
83 -- does NOT assume that anything is in scope already
84 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
85 -- Rename a HsGroup; used for normal source files *and* hs-boot files
86 rnSrcDecls group@(HsGroup {hs_valds  = val_decls,
87                                    hs_tyclds = tycl_decls,
88                                    hs_instds = inst_decls,
89                                    hs_derivds = deriv_decls,
90                                    hs_fixds  = fix_decls,
91                                    hs_warnds  = warn_decls,
92                                    hs_annds  = ann_decls,
93                                    hs_fords  = foreign_decls,
94                                    hs_defds  = default_decls,
95                                    hs_ruleds = rule_decls,
96                                    hs_docs   = docs })
97  = do {
98    -- (A) Process the fixity declarations, creating a mapping from
99    --     FastStrings to FixItems.
100    --     Also checks for duplcates.
101    local_fix_env <- makeMiniFixityEnv fix_decls;
102
103    -- (B) Bring top level binders (and their fixities) into scope,
104    --     *except* for the value bindings, which get brought in below.
105    --     However *do* include class ops, data constructors
106    --     And for hs-boot files *do* include the value signatures
107    tc_avails <- getLocalNonValBinders group ;
108    tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
109    setEnvs tc_envs $ do {
110
111    failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
112
113    -- (C) Extract the mapping from data constructors to field names and
114    --     extend the record field env.
115    --     This depends on the data constructors and field names being in
116    --     scope from (B) above
117    inNewEnv (extendRecordFieldEnv tycl_decls inst_decls) $ \ _ -> do {
118
119    -- (D) Rename the left-hand sides of the value bindings.
120    --     This depends on everything from (B) being in scope,
121    --     and on (C) for resolving record wild cards.
122    --     It uses the fixity env from (A) to bind fixities for view patterns.
123    new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
124    -- bind the LHSes (and their fixities) in the global rdr environment
125    let { val_binders = map unLoc $ collectHsValBinders new_lhs ;
126          val_bndr_set = mkNameSet val_binders ;
127          all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
128          val_avails = map Avail val_binders 
129        } ;
130    (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
131    setEnvs (tcg_env, tcl_env) $ do {
132
133    --  Now everything is in scope, as the remaining renaming assumes.
134
135    -- (E) Rename type and class decls
136    --     (note that value LHSes need to be in scope for default methods)
137    --
138    -- You might think that we could build proper def/use information
139    -- for type and class declarations, but they can be involved
140    -- in mutual recursion across modules, and we only do the SCC
141    -- analysis for them in the type checker.
142    -- So we content ourselves with gathering uses only; that
143    -- means we'll only report a declaration as unused if it isn't
144    -- mentioned at all.  Ah well.
145    traceRn (text "Start rnTyClDecls") ;
146    (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
147
148    -- (F) Rename Value declarations right-hand sides
149    traceRn (text "Start rnmono") ;
150    (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
151    traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
152
153    -- (G) Rename Fixity and deprecations
154    
155    -- Rename fixity declarations and error if we try to
156    -- fix something from another module (duplicates were checked in (A))
157    rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
158
159    -- Rename deprec decls;
160    -- check for duplicates and ensure that deprecated things are defined locally
161    -- at the moment, we don't keep these around past renaming
162    rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
163
164    -- (H) Rename Everything else
165
166    (rn_inst_decls,    src_fvs2) <- rnList rnSrcInstDecl   inst_decls ;
167    (rn_rule_decls,    src_fvs3) <- setOptM Opt_ScopedTypeVariables $
168                                    rnList rnHsRuleDecl    rule_decls ;
169                            -- Inside RULES, scoped type variables are on
170    (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
171    (rn_ann_decls,     src_fvs5) <- rnList rnAnnDecl       ann_decls ;
172    (rn_default_decls, src_fvs6) <- rnList rnDefaultDecl   default_decls ;
173    (rn_deriv_decls,   src_fvs7) <- rnList rnSrcDerivDecl  deriv_decls ;
174       -- Haddock docs; no free vars
175    rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
176
177    -- (I) Compute the results and return
178    let {rn_group = HsGroup { hs_valds  = rn_val_decls,
179                              hs_tyclds = rn_tycl_decls,
180                              hs_instds = rn_inst_decls,
181                              hs_derivds = rn_deriv_decls,
182                              hs_fixds  = rn_fix_decls,
183                              hs_warnds = [], -- warns are returned in the tcg_env
184                                              -- (see below) not in the HsGroup
185                              hs_fords  = rn_foreign_decls,
186                              hs_annds   = rn_ann_decls,
187                              hs_defds  = rn_default_decls,
188                              hs_ruleds = rn_rule_decls,
189                              hs_docs   = rn_docs } ;
190
191         other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4, 
192                              src_fvs5, src_fvs6, src_fvs7] ;
193         src_dus = bind_dus `plusDU` usesOnly other_fvs;
194                 -- Note: src_dus will contain *uses* for locally-defined types
195                 -- and classes, but no *defs* for them.  (Because rnTyClDecl 
196                 -- returns only the uses.)  This is a little 
197                 -- surprising but it doesn't actually matter at all.
198
199        final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
200                        in -- we return the deprecs in the env, not in the HsGroup above
201                          tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
202        } ;
203
204    traceRn (text "finish rnSrc" <+> ppr rn_group) ;
205    traceRn (text "finish Dus" <+> ppr src_dus ) ;
206    return (final_tcg_env , rn_group)
207                     }}}}
208
209 -- some utils because we do this a bunch above
210 -- compute and install the new env
211 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
212 inNewEnv env cont = do e <- env
213                        setGblEnv e $ cont e
214
215 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
216 -- Used for external core
217 rnTyClDecls tycl_decls = do  (decls', _fvs) <- rnList rnTyClDecl tycl_decls
218                              return decls'
219
220 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv 
221 -- This function could be defined lower down in the module hierarchy, 
222 -- but there doesn't seem anywhere very logical to put it.
223 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
224
225 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
226 rnList f xs = mapFvRn (wrapLocFstM f) xs
227 \end{code}
228
229
230 %*********************************************************
231 %*                                                       *
232         HsDoc stuff
233 %*                                                       *
234 %*********************************************************
235
236 \begin{code}
237 rnDocDecl :: DocDecl -> RnM DocDecl
238 rnDocDecl (DocCommentNext doc) = do 
239   rn_doc <- rnHsDoc doc
240   return (DocCommentNext rn_doc)
241 rnDocDecl (DocCommentPrev doc) = do 
242   rn_doc <- rnHsDoc doc
243   return (DocCommentPrev rn_doc)
244 rnDocDecl (DocCommentNamed str doc) = do
245   rn_doc <- rnHsDoc doc
246   return (DocCommentNamed str rn_doc)
247 rnDocDecl (DocGroup lev doc) = do
248   rn_doc <- rnHsDoc doc
249   return (DocGroup lev rn_doc)
250 \end{code}
251
252
253 %*********************************************************
254 %*                                                       *
255         Source-code fixity declarations
256 %*                                                       *
257 %*********************************************************
258
259 \begin{code}
260 rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
261 -- Rename the fixity decls, so we can put
262 -- the renamed decls in the renamed syntax tree
263 -- Errors if the thing being fixed is not defined locally.
264 --
265 -- The returned FixitySigs are not actually used for anything,
266 -- except perhaps the GHCi API
267 rnSrcFixityDecls bound_names fix_decls
268   = do fix_decls <- mapM rn_decl fix_decls
269        return (concat fix_decls)
270   where
271     rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
272         -- GHC extension: look up both the tycon and data con 
273         -- for con-like things; hence returning a list
274         -- If neither are in scope, report an error; otherwise
275         -- return a fixity sig for each (slightly odd)
276     rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
277       = setSrcSpan name_loc $
278                     -- this lookup will fail if the definition isn't local
279         do names <- lookupLocalDataTcNames bound_names what rdr_name
280            return [ L loc (FixitySig (L name_loc name) fixity)
281                   | name <- names ]
282     what = ptext (sLit "fixity signature")
283 \end{code}
284
285
286 %*********************************************************
287 %*                                                       *
288         Source-code deprecations declarations
289 %*                                                       *
290 %*********************************************************
291
292 Check that the deprecated names are defined, are defined locally, and
293 that there are no duplicate deprecations.
294
295 It's only imported deprecations, dealt with in RnIfaces, that we
296 gather them together.
297
298 \begin{code}
299 -- checks that the deprecations are defined locally, and that there are no duplicates
300 rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
301 rnSrcWarnDecls _bound_names [] 
302   = return NoWarnings
303
304 rnSrcWarnDecls bound_names decls 
305   = do { -- check for duplicates
306        ; mapM_ (\ (L loc rdr:lrdr':_) -> addErrAt loc (dupWarnDecl lrdr' rdr)) 
307                warn_rdr_dups
308        ; pairs_s <- mapM (addLocM rn_deprec) decls
309        ; return (WarnSome ((concat pairs_s))) }
310  where
311    rn_deprec (Warning rdr_name txt)
312        -- ensures that the names are defined locally
313      = lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
314        return [(nameOccName name, txt) | name <- names]
315    
316    what = ptext (sLit "deprecation")
317
318    -- look for duplicates among the OccNames;
319    -- we check that the names are defined above
320    -- invt: the lists returned by findDupsEq always have at least two elements
321    warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
322                      (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
323                
324 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
325 -- Located RdrName -> DeprecDecl RdrName -> SDoc
326 dupWarnDecl (L loc _) rdr_name
327   = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
328           ptext (sLit "also at ") <+> ppr loc]
329
330 \end{code}
331
332 %*********************************************************
333 %*                                                      *
334 \subsection{Annotation declarations}
335 %*                                                      *
336 %*********************************************************
337
338 \begin{code}
339 rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
340 rnAnnDecl (HsAnnotation provenance expr) = do
341     (provenance', provenance_fvs) <- rnAnnProvenance provenance
342     (expr', expr_fvs) <- rnLExpr expr
343     return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs)
344
345 rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
346 rnAnnProvenance provenance = do
347     provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
348     return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
349 \end{code}
350
351 %*********************************************************
352 %*                                                      *
353 \subsection{Default declarations}
354 %*                                                      *
355 %*********************************************************
356
357 \begin{code}
358 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
359 rnDefaultDecl (DefaultDecl tys)
360   = mapFvRn (rnHsTypeFVs doc_str) tys   `thenM` \ (tys', fvs) ->
361     return (DefaultDecl tys', fvs)
362   where
363     doc_str = text "In a `default' declaration"
364 \end{code}
365
366 %*********************************************************
367 %*                                                      *
368 \subsection{Foreign declarations}
369 %*                                                      *
370 %*********************************************************
371
372 \begin{code}
373 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
374 rnHsForeignDecl (ForeignImport name ty spec)
375   = getTopEnv                           `thenM` \ (topEnv :: HscEnv) ->
376     lookupLocatedTopBndrRn name         `thenM` \ name' ->
377     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
378
379     -- Mark any PackageTarget style imports as coming from the current package
380     let packageId       = thisPackage $ hsc_dflags topEnv
381         spec'           = patchForeignImport packageId spec
382
383     in  return (ForeignImport name' ty' spec', fvs)
384
385 rnHsForeignDecl (ForeignExport name ty spec)
386   = lookupLocatedOccRn name             `thenM` \ name' ->
387     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
388     return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
389         -- NB: a foreign export is an *occurrence site* for name, so 
390         --     we add it to the free-variable list.  It might, for example,
391         --     be imported from another module
392
393 fo_decl_msg :: Located RdrName -> SDoc
394 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
395
396
397 -- | For Windows DLLs we need to know what packages imported symbols are from
398 --      to generate correct calls. Imported symbols are tagged with the current
399 --      package, so if they get inlined across a package boundry we'll still
400 --      know where they're from.
401 --
402 patchForeignImport :: PackageId -> ForeignImport -> ForeignImport
403 patchForeignImport packageId (CImport cconv safety fs spec)
404         = CImport cconv safety fs (patchCImportSpec packageId spec) 
405
406 patchCImportSpec :: PackageId -> CImportSpec -> CImportSpec
407 patchCImportSpec packageId spec
408  = case spec of
409         CFunction callTarget    -> CFunction $ patchCCallTarget packageId callTarget
410         _                       -> spec
411
412 patchCCallTarget :: PackageId -> CCallTarget -> CCallTarget
413 patchCCallTarget packageId callTarget
414  = case callTarget of
415         StaticTarget label Nothing
416          -> StaticTarget label (Just packageId)
417
418         _                       -> callTarget   
419
420
421 \end{code}
422
423
424 %*********************************************************
425 %*                                                      *
426 \subsection{Instance declarations}
427 %*                                                      *
428 %*********************************************************
429
430 \begin{code}
431 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
432 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
433         -- Used for both source and interface file decls
434   = rnHsSigType (text "an instance decl") inst_ty       `thenM` \ inst_ty' ->
435
436         -- Rename the bindings
437         -- The typechecker (not the renamer) checks that all 
438         -- the bindings are for the right class
439     let
440         meth_names  = collectHsBindLocatedBinders mbinds
441         (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
442     in
443     checkDupRdrNames meth_names         `thenM_`
444         -- Check that the same method is not given twice in the
445         -- same instance decl   instance C T where
446         --                            f x = ...
447         --                            g y = ...
448         --                            f x = ...
449         -- We must use checkDupRdrNames because the Name of the
450         -- method is the Name of the class selector, whose SrcSpan
451         -- points to the class declaration
452
453     extendTyVarEnvForMethodBinds inst_tyvars (          
454         -- (Slightly strangely) the forall-d tyvars scope over
455         -- the method bindings too
456         rnMethodBinds cls (\_ -> [])    -- No scoped tyvars
457                       [] mbinds
458     )                                           `thenM` \ (mbinds', meth_fvs) ->
459         -- Rename the associated types
460         -- The typechecker (not the renamer) checks that all 
461         -- the declarations are for the right class
462     let
463         at_names = map (head . tyClDeclNames . unLoc) ats
464     in
465     checkDupRdrNames at_names           `thenM_`
466         -- See notes with checkDupRdrNames for methods, above
467
468     rnATInsts ats                               `thenM` \ (ats', at_fvs) ->
469
470         -- Rename the prags and signatures.
471         -- Note that the type variables are not in scope here,
472         -- so that      instance Eq a => Eq (T a) where
473         --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
474         -- works OK. 
475         --
476         -- But the (unqualified) method names are in scope
477     let 
478         binders = collectHsBindBinders mbinds'
479         bndr_set = mkNameSet binders
480     in
481     bindLocalNames binders 
482         (renameSigs (Just bndr_set) okInstDclSig uprags)        `thenM` \ uprags' ->
483
484     return (InstDecl inst_ty' mbinds' uprags' ats',
485              meth_fvs `plusFV` at_fvs
486                       `plusFV` hsSigsFVs uprags'
487                       `plusFV` extractHsTyNames inst_ty')
488              -- We return the renamed associated data type declarations so
489              -- that they can be entered into the list of type declarations
490              -- for the binding group, but we also keep a copy in the instance.
491              -- The latter is needed for well-formedness checks in the type
492              -- checker (eg, to ensure that all ATs of the instance actually
493              -- receive a declaration). 
494              -- NB: Even the copies in the instance declaration carry copies of
495              --     the instance context after renaming.  This is a bit
496              --     strange, but should not matter (and it would be more work
497              --     to remove the context).
498 \end{code}
499
500 Renaming of the associated types in instances.  
501
502 \begin{code}
503 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
504 rnATInsts atDecls = rnList rnATInst atDecls
505   where
506     rnATInst tydecl@TyData     {} = rnTyClDecl tydecl
507     rnATInst tydecl@TySynonym  {} = rnTyClDecl tydecl
508     rnATInst tydecl               =
509       pprPanic "RnSource.rnATInsts: invalid AT instance" 
510                (ppr (tcdName tydecl))
511 \end{code}
512
513 For the method bindings in class and instance decls, we extend the 
514 type variable environment iff -fglasgow-exts
515
516 \begin{code}
517 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
518                              -> RnM (Bag (LHsBind Name), FreeVars)
519                              -> RnM (Bag (LHsBind Name), FreeVars)
520 extendTyVarEnvForMethodBinds tyvars thing_inside
521   = do  { scoped_tvs <- doptM Opt_ScopedTypeVariables
522         ; if scoped_tvs then
523                 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
524           else
525                 thing_inside }
526 \end{code}
527
528 %*********************************************************
529 %*                                                      *
530 \subsection{Stand-alone deriving declarations}
531 %*                                                      *
532 %*********************************************************
533
534 \begin{code}
535 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
536 rnSrcDerivDecl (DerivDecl ty)
537   = do { standalone_deriv_ok <- doptM Opt_StandaloneDeriving
538        ; unless standalone_deriv_ok (addErr standaloneDerivErr)
539        ; ty' <- rnLHsType (text "a deriving decl") ty
540        ; let fvs = extractHsTyNames ty'
541        ; return (DerivDecl ty', fvs) }
542
543 standaloneDerivErr :: SDoc
544 standaloneDerivErr 
545   = hang (ptext (sLit "Illegal standalone deriving declaration"))
546        2 (ptext (sLit "Use -XStandaloneDeriving to enable this extension"))
547 \end{code}
548
549 %*********************************************************
550 %*                                                      *
551 \subsection{Rules}
552 %*                                                      *
553 %*********************************************************
554
555 \begin{code}
556 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
557 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
558   = bindPatSigTyVarsFV (collectRuleBndrSigTys vars)     $
559     bindLocatedLocalsFV (map get_var vars)              $ \ ids ->
560     do  { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
561                 -- NB: The binders in a rule are always Ids
562                 --     We don't (yet) support type variables
563
564         ; (lhs', fv_lhs') <- rnLExpr lhs
565         ; (rhs', fv_rhs') <- rnLExpr rhs
566
567         ; checkValidRule rule_name ids lhs' fv_lhs'
568
569         ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
570                   fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
571   where
572     doc = text "In the transformation rule" <+> ftext rule_name
573   
574     get_var (RuleBndr v)      = v
575     get_var (RuleBndrSig v _) = v
576
577     rn_var (RuleBndr (L loc _), id)
578         = return (RuleBndr (L loc id), emptyFVs)
579     rn_var (RuleBndrSig (L loc _) t, id)
580         = rnHsTypeFVs doc t     `thenM` \ (t', fvs) ->
581           return (RuleBndrSig (L loc id) t', fvs)
582
583 badRuleVar :: FastString -> Name -> SDoc
584 badRuleVar name var
585   = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
586          ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+> 
587                 ptext (sLit "does not appear on left hand side")]
588 \end{code}
589
590 Note [Rule LHS validity checking]
591 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
592 Check the shape of a transformation rule LHS.  Currently we only allow
593 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
594 @forall@'d variables.  
595
596 We used restrict the form of the 'ei' to prevent you writing rules
597 with LHSs with a complicated desugaring (and hence unlikely to match);
598 (e.g. a case expression is not allowed: too elaborate.)
599
600 But there are legitimate non-trivial args ei, like sections and
601 lambdas.  So it seems simmpler not to check at all, and that is why
602 check_e is commented out.
603         
604 \begin{code}
605 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
606 checkValidRule rule_name ids lhs' fv_lhs'
607   = do  {       -- Check for the form of the LHS
608           case (validRuleLhs ids lhs') of
609                 Nothing  -> return ()
610                 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
611
612                 -- Check that LHS vars are all bound
613         ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
614         ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
615
616 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
617 -- Nothing => OK
618 -- Just e  => Not ok, and e is the offending expression
619 validRuleLhs foralls lhs
620   = checkl lhs
621   where
622     checkl (L _ e) = check e
623
624     check (OpApp e1 op _ e2)              = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
625     check (HsApp e1 e2)                   = checkl e1 `mplus` checkl_e e2
626     check (HsVar v) | v `notElem` foralls = Nothing
627     check other                           = Just other  -- Failure
628
629         -- Check an argument
630     checkl_e (L _ _e) = Nothing         -- Was (check_e e); see Note [Rule LHS validity checking]
631
632 {-      Commented out; see Note [Rule LHS validity checking] above 
633     check_e (HsVar v)     = Nothing
634     check_e (HsPar e)     = checkl_e e
635     check_e (HsLit e)     = Nothing
636     check_e (HsOverLit e) = Nothing
637
638     check_e (OpApp e1 op _ e2)   = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
639     check_e (HsApp e1 e2)        = checkl_e e1 `mplus` checkl_e e2
640     check_e (NegApp e _)         = checkl_e e
641     check_e (ExplicitList _ es)  = checkl_es es
642     check_e other                = Just other   -- Fails
643
644     checkl_es es = foldr (mplus . checkl_e) Nothing es
645 -}
646
647 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
648 badRuleLhsErr name lhs bad_e
649   = sep [ptext (sLit "Rule") <+> ftext name <> colon,
650          nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e, 
651                        ptext (sLit "in left-hand side:") <+> ppr lhs])]
652     $$
653     ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
654 \end{code}
655
656
657 %*********************************************************
658 %*                                                      *
659 \subsection{Type, class and iface sig declarations}
660 %*                                                      *
661 %*********************************************************
662
663 @rnTyDecl@ uses the `global name function' to create a new type
664 declaration in which local names have been replaced by their original
665 names, reporting any unknown names.
666
667 Renaming type variables is a pain. Because they now contain uniques,
668 it is necessary to pass in an association list which maps a parsed
669 tyvar to its @Name@ representation.
670 In some cases (type signatures of values),
671 it is even necessary to go over the type first
672 in order to get the set of tyvars used by it, make an assoc list,
673 and then go over it again to rename the tyvars!
674 However, we can also do some scoping checks at the same time.
675
676 \begin{code}
677 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
678 rnTyClDecl (ForeignType {tcdLName = name, tcdExtName = ext_name})
679   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
680     return (ForeignType {tcdLName = name', tcdExtName = ext_name},
681              emptyFVs)
682
683 -- all flavours of type family declarations ("type family", "newtype fanily",
684 -- and "data family")
685 rnTyClDecl (tydecl@TyFamily {}) =
686   rnFamily tydecl bindTyVarsRn
687
688 -- "data", "newtype", "data instance, and "newtype instance" declarations
689 rnTyClDecl tydecl@TyData {tcdND = new_or_data, tcdCtxt = context, 
690                            tcdLName = tycon, tcdTyVars = tyvars, 
691                            tcdTyPats = typatsMaybe, tcdCons = condecls, 
692                            tcdKindSig = sig, tcdDerivs = derivs}
693   = do  { tycon' <- if isFamInstDecl tydecl
694                     then lookupLocatedOccRn     tycon -- may be imported family
695                     else lookupLocatedTopBndrRn tycon
696         ; checkTc (h98_style || null (unLoc context)) 
697                   (badGadtStupidTheta tycon)
698         ; (tyvars', context', typats', derivs', deriv_fvs)
699                 <- bindTyVarsRn tyvars $ \ tyvars' -> do
700                                  -- Checks for distinct tyvars
701                    { typats' <- rnTyPats data_doc typatsMaybe
702                    ; context' <- rnContext data_doc context
703                    ; (derivs', deriv_fvs) <- rn_derivs derivs
704                    ; return (tyvars', context', typats', derivs', deriv_fvs) }
705                 -- For GADTs, the type variables in the declaration 
706                 -- do not scope over the constructor signatures
707                 --      data T a where { T1 :: forall b. b-> b }
708
709         -- For the constructor declarations, bring into scope the tyvars 
710         -- bound by the header, but *only* in the H98 case
711         ; let tc_tvs_in_scope | h98_style = hsLTyVarNames tyvars'
712                               | otherwise = []
713         ; (condecls', con_fvs) <- bindLocalNamesFV tc_tvs_in_scope $
714                                   rnConDecls condecls
715                 -- No need to check for duplicate constructor decls
716                 -- since that is done by RnNames.extendGlobalRdrEnvRn
717
718         ; return (TyData {tcdND = new_or_data, tcdCtxt = context', 
719                            tcdLName = tycon', tcdTyVars = tyvars', 
720                            tcdTyPats = typats', tcdKindSig = sig,
721                            tcdCons = condecls', tcdDerivs = derivs'}, 
722                    con_fvs              `plusFV` 
723                    deriv_fvs            `plusFV`
724                    (if isFamInstDecl tydecl
725                    then unitFV (unLoc tycon')   -- type instance => use
726                    else emptyFVs))
727         }
728   where
729     h98_style = case condecls of         -- Note [Stupid theta]
730                      L _ (ConDecl { con_res = ResTyGADT {} }) : _  -> False
731                      _                                             -> True
732                                                                           
733     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
734
735     rn_derivs Nothing   = return (Nothing, emptyFVs)
736     rn_derivs (Just ds) = rnLHsTypes data_doc ds        `thenM` \ ds' -> 
737                           return (Just ds', extractHsTyNames_s ds')
738
739 -- "type" and "type instance" declarations
740 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
741                               tcdTyPats = typatsMaybe, tcdSynRhs = ty})
742   = bindTyVarsRn tyvars $ \ tyvars' -> do
743     {            -- Checks for distinct tyvars
744       name' <- if isFamInstDecl tydecl
745                   then lookupLocatedOccRn     name -- may be imported family
746                   else lookupLocatedTopBndrRn name
747     ; typats' <- rnTyPats syn_doc typatsMaybe
748     ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
749     ; return (TySynonym { tcdLName = name', tcdTyVars = tyvars' 
750                         , tcdTyPats = typats', tcdSynRhs = ty'},
751               delFVs (map hsLTyVarName tyvars') $
752               fvs                             `plusFV`
753                (if isFamInstDecl tydecl
754                then unitFV (unLoc name')        -- type instance => use
755                else emptyFVs))
756     }
757   where
758     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
759
760 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname, 
761                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs, 
762                        tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
763   = do  { cname' <- lookupLocatedTopBndrRn cname
764
765         -- Tyvars scope over superclass context and method signatures
766         ; (tyvars', context', fds', ats', ats_fvs, sigs')
767             <- bindTyVarsRn tyvars $ \ tyvars' -> do
768                  -- Checks for distinct tyvars
769              { context' <- rnContext cls_doc context
770              ; fds' <- rnFds cls_doc fds
771              ; (ats', ats_fvs) <- rnATs ats
772              ; sigs' <- renameSigs Nothing okClsDclSig sigs
773              ; return   (tyvars', context', fds', ats', ats_fvs, sigs') }
774
775         -- No need to check for duplicate associated type decls
776         -- since that is done by RnNames.extendGlobalRdrEnvRn
777
778         -- Check the signatures
779         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
780         ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
781         ; checkDupRdrNames sig_rdr_names_w_locs
782                 -- Typechecker is responsible for checking that we only
783                 -- give default-method bindings for things in this class.
784                 -- The renamer *could* check this for class decls, but can't
785                 -- for instance decls.
786
787         -- The newLocals call is tiresome: given a generic class decl
788         --      class C a where
789         --        op :: a -> a
790         --        op {| x+y |} (Inl a) = ...
791         --        op {| x+y |} (Inr b) = ...
792         --        op {| a*b |} (a*b)   = ...
793         -- we want to name both "x" tyvars with the same unique, so that they are
794         -- easy to group together in the typechecker.  
795         ; (mbinds', meth_fvs) 
796             <- extendTyVarEnvForMethodBinds tyvars' $ do
797             { name_env <- getLocalRdrEnv
798             ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
799                                                  not (unLoc tv `elemLocalRdrEnv` name_env) ]
800                 -- No need to check for duplicate method signatures
801                 -- since that is done by RnNames.extendGlobalRdrEnvRn
802                 -- and the methods are already in scope
803             ; gen_tyvars <- newLocalBndrsRn gen_rdr_tyvars_w_locs
804             ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
805
806   -- Haddock docs 
807         ; docs' <- mapM (wrapLocM rnDocDecl) docs
808
809         ; return (ClassDecl { tcdCtxt = context', tcdLName = cname', 
810                               tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
811                               tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
812
813                   delFVs (map hsLTyVarName tyvars')     $
814                   extractHsCtxtTyNames context'         `plusFV`
815                   plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
816                   hsSigsFVs sigs'                       `plusFV`
817                   meth_fvs                              `plusFV`
818                   ats_fvs) }
819   where
820     cls_doc  = text "In the declaration for class"      <+> ppr cname
821
822 badGadtStupidTheta :: Located RdrName -> SDoc
823 badGadtStupidTheta _
824   = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
825           ptext (sLit "(You can put a context on each contructor, though.)")]
826 \end{code}
827
828 Note [Stupid theta]
829 ~~~~~~~~~~~~~~~~~~~
830 Trac #3850 complains about a regression wrt 6.10 for 
831      data Show a => T a
832 There is no reason not to allow the stupid theta if there are no data
833 constructors.  It's still stupid, but does no harm, and I don't want
834 to cause programs to break unnecessarily (notably HList).  So if there
835 are no data constructors we allow h98_style = True
836
837
838 %*********************************************************
839 %*                                                      *
840 \subsection{Support code for type/data declarations}
841 %*                                                      *
842 %*********************************************************
843
844 \begin{code}
845 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
846 -- Although, we are processing type patterns here, all type variables will
847 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
848 -- type declaration to which these patterns belong)
849 rnTyPats _   Nothing       = return Nothing
850 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
851
852 rnConDecls :: [LConDecl RdrName] -> RnM ([LConDecl Name], FreeVars)
853 rnConDecls condecls
854   = do { condecls' <- mapM (wrapLocM rnConDecl) condecls
855        ; return (condecls', plusFVs (map conDeclFVs condecls')) }
856
857 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
858 rnConDecl decl@(ConDecl { con_name = name, con_qvars = tvs
859                                , con_cxt = cxt, con_details = details
860                                , con_res = res_ty, con_doc = mb_doc
861                                , con_old_rec = old_rec, con_explicit = expl })
862   = do  { addLocM checkConName name
863         ; when old_rec (addWarn (deprecRecSyntax decl))
864         ; new_name <- lookupLocatedTopBndrRn name
865
866            -- For H98 syntax, the tvs are the existential ones
867            -- For GADT syntax, the tvs are all the quantified tyvars
868            -- Hence the 'filter' in the ResTyH98 case only
869         ; rdr_env <- getLocalRdrEnv
870         ; let in_scope     = (`elemLocalRdrEnv` rdr_env) . unLoc
871               arg_tys      = hsConDeclArgTys details
872               implicit_tvs = case res_ty of
873                                ResTyH98 -> filterOut in_scope (get_rdr_tvs arg_tys)
874                                ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
875               new_tvs = case expl of
876                           Explicit -> tvs
877                           Implicit -> userHsTyVarBndrs implicit_tvs
878
879         ; mb_doc' <- rnMbLHsDoc mb_doc 
880
881         ; bindTyVarsRn new_tvs $ \new_tyvars -> do
882         { new_context <- rnContext doc cxt
883         ; new_details <- rnConDeclDetails doc details
884         ; (new_details', new_res_ty)  <- rnConResult doc new_details res_ty
885         ; return (decl { con_name = new_name, con_qvars = new_tyvars, con_cxt = new_context 
886                        , con_details = new_details', con_res = new_res_ty, con_doc = mb_doc' }) }}
887  where
888     doc = text "In the definition of data constructor" <+> quotes (ppr name)
889     get_rdr_tvs tys  = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
890
891 rnConResult :: SDoc
892             -> HsConDetails (LHsType Name) [ConDeclField Name]
893             -> ResType RdrName
894             -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
895                     ResType Name)
896 rnConResult _ details ResTyH98 = return (details, ResTyH98)
897 rnConResult doc details (ResTyGADT ty)
898   = do { ty' <- rnLHsType doc ty
899        ; let (arg_tys, res_ty) = splitHsFunType ty'
900                 -- We can finally split it up, 
901                 -- now the renamer has dealt with fixities
902                 -- See Note [Sorting out the result type] in RdrHsSyn
903
904              details' = case details of
905                            RecCon {}    -> details
906                            PrefixCon {} -> PrefixCon arg_tys
907                            InfixCon {}  -> pprPanic "rnConResult" (ppr ty)
908                           -- See Note [Sorting out the result type] in RdrHsSyn
909                 
910        ; when (not (null arg_tys) && case details of { RecCon {} -> True; _ -> False })
911               (addErr (badRecResTy doc))
912        ; return (details', ResTyGADT res_ty) }
913
914 rnConDeclDetails :: SDoc
915                  -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
916                  -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
917 rnConDeclDetails doc (PrefixCon tys)
918   = mapM (rnLHsType doc) tys    `thenM` \ new_tys  ->
919     return (PrefixCon new_tys)
920
921 rnConDeclDetails doc (InfixCon ty1 ty2)
922   = rnLHsType doc ty1           `thenM` \ new_ty1 ->
923     rnLHsType doc ty2           `thenM` \ new_ty2 ->
924     return (InfixCon new_ty1 new_ty2)
925
926 rnConDeclDetails doc (RecCon fields)
927   = do  { new_fields <- rnConDeclFields doc fields
928                 -- No need to check for duplicate fields
929                 -- since that is done by RnNames.extendGlobalRdrEnvRn
930         ; return (RecCon new_fields) }
931
932 -- Rename family declarations
933 --
934 -- * This function is parametrised by the routine handling the index
935 --   variables.  On the toplevel, these are defining occurences, whereas they
936 --   are usage occurences for associated types.
937 --
938 rnFamily :: TyClDecl RdrName 
939          -> ([LHsTyVarBndr RdrName] -> 
940              ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
941              RnM (TyClDecl Name, FreeVars))
942          -> RnM (TyClDecl Name, FreeVars)
943
944 rnFamily (tydecl@TyFamily {tcdFlavour = flavour, 
945                            tcdLName = tycon, tcdTyVars = tyvars}) 
946         bindIdxVars =
947       do { bindIdxVars tyvars $ \tyvars' -> do {
948          ; tycon' <- lookupLocatedTopBndrRn tycon
949          ; return (TyFamily {tcdFlavour = flavour, tcdLName = tycon', 
950                               tcdTyVars = tyvars', tcdKind = tcdKind tydecl}, 
951                     emptyFVs) 
952          } }
953 rnFamily d _ = pprPanic "rnFamily" (ppr d)
954
955 -- Rename associated type declarations (in classes)
956 --
957 -- * This can be family declarations and (default) type instances
958 --
959 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
960 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
961   where
962     rn_at (tydecl@TyFamily  {}) = rnFamily tydecl lookupIdxVars
963     rn_at (tydecl@TySynonym {}) = 
964       do
965         unless (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
966         rnTyClDecl tydecl
967     rn_at _                      = panic "RnSource.rnATs: invalid TyClDecl"
968
969     lookupIdxVars tyvars cont = 
970       do { checkForDups tyvars;
971          ; tyvars' <- mapM lookupIdxVar tyvars
972          ; cont tyvars'
973          }
974     -- Type index variables must be class parameters, which are the only
975     -- type variables in scope at this point.
976     lookupIdxVar (L l tyvar) =
977       do
978         name' <- lookupOccRn (hsTyVarName tyvar)
979         return $ L l (replaceTyVarName tyvar name')
980
981     -- Type variable may only occur once.
982     --
983     checkForDups [] = return ()
984     checkForDups (L loc tv:ltvs) = 
985       do { setSrcSpan loc $
986              when (hsTyVarName tv `ltvElem` ltvs) $
987                addErr (repeatedTyVar tv)
988          ; checkForDups ltvs
989          }
990
991     _       `ltvElem` [] = False
992     rdrName `ltvElem` (L _ tv:ltvs)
993       | rdrName == hsTyVarName tv = True
994       | otherwise                 = rdrName `ltvElem` ltvs
995
996 deprecRecSyntax :: ConDecl RdrName -> SDoc
997 deprecRecSyntax decl 
998   = vcat [ ptext (sLit "Declaration of") <+> quotes (ppr (con_name decl))
999                  <+> ptext (sLit "uses deprecated syntax")
1000          , ptext (sLit "Instead, use the form")
1001          , nest 2 (ppr decl) ]   -- Pretty printer uses new form
1002
1003 badRecResTy :: SDoc -> SDoc
1004 badRecResTy doc = ptext (sLit "Malformed constructor signature") $$ doc
1005
1006 noPatterns :: SDoc
1007 noPatterns = text "Default definition for an associated synonym cannot have"
1008              <+> text "type pattern"
1009
1010 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
1011 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
1012                    quotes (ppr tv)
1013
1014 -- This data decl will parse OK
1015 --      data T = a Int
1016 -- treating "a" as the constructor.
1017 -- It is really hard to make the parser spot this malformation.
1018 -- So the renamer has to check that the constructor is legal
1019 --
1020 -- We can get an operator as the constructor, even in the prefix form:
1021 --      data T = :% Int Int
1022 -- from interface files, which always print in prefix form
1023
1024 checkConName :: RdrName -> TcRn ()
1025 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1026
1027 badDataCon :: RdrName -> SDoc
1028 badDataCon name
1029    = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1030 \end{code}
1031
1032
1033 %*********************************************************
1034 %*                                                      *
1035 \subsection{Support code for type/data declarations}
1036 %*                                                      *
1037 %*********************************************************
1038
1039 Get the mapping from constructors to fields for this module.
1040 It's convenient to do this after the data type decls have been renamed
1041 \begin{code}
1042 extendRecordFieldEnv :: [LTyClDecl RdrName] -> [LInstDecl RdrName] -> TcM TcGblEnv
1043 extendRecordFieldEnv tycl_decls inst_decls
1044   = do  { tcg_env <- getGblEnv
1045         ; field_env' <- foldrM get_con (tcg_field_env tcg_env) all_data_cons
1046         ; return (tcg_env { tcg_field_env = field_env' }) }
1047   where
1048     -- we want to lookup:
1049     --  (a) a datatype constructor
1050     --  (b) a record field
1051     -- knowing that they're from this module.
1052     -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1053     -- which keeps only the local ones.
1054     lookup x = do { x' <- lookupLocatedTopBndrRn x
1055                     ; return $ unLoc x'}
1056
1057     all_data_cons :: [ConDecl RdrName]
1058     all_data_cons = [con | L _ (TyData { tcdCons = cons }) <- all_tycl_decls
1059                          , L _ con <- cons ]
1060     all_tycl_decls = at_tycl_decls ++ tycl_decls
1061     at_tycl_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
1062                       -- Do not forget associated types!
1063
1064     get_con (ConDecl { con_name = con, con_details = RecCon flds })
1065             (RecFields env fld_set)
1066         = do { con' <- lookup con
1067              ; flds' <- mapM lookup (map cd_fld_name flds)
1068              ; let env'    = extendNameEnv env con' flds'
1069                    fld_set' = addListToNameSet fld_set flds'
1070              ; return $ (RecFields env' fld_set') }
1071     get_con _ env = return env
1072 \end{code}
1073
1074 %*********************************************************
1075 %*                                                      *
1076 \subsection{Support code to rename types}
1077 %*                                                      *
1078 %*********************************************************
1079
1080 \begin{code}
1081 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1082
1083 rnFds doc fds
1084   = mapM (wrapLocM rn_fds) fds
1085   where
1086     rn_fds (tys1, tys2)
1087       = rnHsTyVars doc tys1             `thenM` \ tys1' ->
1088         rnHsTyVars doc tys2             `thenM` \ tys2' ->
1089         return (tys1', tys2')
1090
1091 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1092 rnHsTyVars doc tvs  = mapM (rnHsTyVar doc) tvs
1093
1094 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1095 rnHsTyVar _doc tyvar = lookupOccRn tyvar
1096 \end{code}
1097
1098