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