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