compiler/rename/RnSource.lhs

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