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