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