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