compiler/rename/RnSource.lhs

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