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   = ASSERT( none typatsMaybe )    -- GADTs cannot have type patterns for now
 665     do  { tycon' <- if isFamInstDecl tydecl
 666                     then lookupLocatedOccRn     tycon -- may be imported family
 667                     else lookupLocatedTopBndrRn tycon
 668         ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
 669         ; tyvars' <- bindTyVarsRn data_doc tyvars
 670                                   (\ tyvars' -> return tyvars')
 671                 -- For GADTs, the type variables in the declaration
 672                 -- do not scope over the constructor signatures
 673                 --      data T a where { T1 :: forall b. b-> b }
 674         ; (derivs', deriv_fvs) <- rn_derivs derivs
 675         ; condecls' <- rnConDecls (unLoc tycon') condecls
 676                 -- No need to check for duplicate constructor decls
 677                 -- since that is done by RnNames.extendGlobalRdrEnvRn
 678         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
 679                            tcdLName = tycon', tcdTyVars = tyvars',
 680                            tcdTyPats = Nothing, tcdKindSig = sig,
 681                            tcdCons = condecls', tcdDerivs = derivs'},
 682                    plusFVs (map conDeclFVs condecls') `plusFV`
 683                    deriv_fvs                          `plusFV`
 684                    (if isFamInstDecl tydecl
 685                    then unitFV (unLoc tycon')   -- type instance => use
 686                    else emptyFVs))
 687         }
 688   where
 689     is_vanilla = case condecls of       -- Yuk
 690                      []                    -> True
 691                      L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
 692                      _                     -> False
 693
 694     none Nothing   = True
 695     none (Just []) = True
 696     none _         = False
 697
 698     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 699
 700     rn_derivs Nothing   = returnM (Nothing, emptyFVs)
 701     rn_derivs (Just ds) = rnLHsTypes data_doc ds        `thenM` \ ds' ->
 702                           returnM (Just ds', extractHsTyNames_s ds')
 703
 704 -- "type" and "type instance" declarations
 705 rnTyClDecl tydecl@(TySynonym {tcdLName = name,
 706                               tcdTyPats = typatsMaybe, tcdSynRhs = ty})
 707   = do { tyvars <- pruneTyVars tydecl
 708        ; bindTyVarsRn syn_doc tyvars                    $ \ tyvars' -> do
 709        { name' <- if isFamInstDecl tydecl
 710                   then lookupLocatedOccRn     name -- may be imported family
 711                   else lookupLocatedTopBndrRn name
 712        ; typats' <- rnTyPats syn_doc typatsMaybe
 713        ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
 714        ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
 715                              tcdTyPats = typats', tcdSynRhs = ty'},
 716                   delFVs (map hsLTyVarName tyvars') $
 717                   fvs                         `plusFV`
 718                    (if isFamInstDecl tydecl
 719                    then unitFV (unLoc name')    -- type instance => use
 720                    else emptyFVs))
 721        } }
 722   where
 723     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 724
 725 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
 726                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 727                        tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
 728   = do  { cname' <- lookupLocatedTopBndrRn cname
 729
 730         -- Tyvars scope over superclass context and method signatures
 731         ; (tyvars', context', fds', ats', ats_fvs, sigs')
 732             <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
 733              { context' <- rnContext cls_doc context
 734              ; fds' <- rnFds cls_doc fds
 735              ; (ats', ats_fvs) <- rnATs ats
 736              ; sigs' <- renameSigs Nothing okClsDclSig sigs
 737              ; return   (tyvars', context', fds', ats', ats_fvs, sigs') }
 738
 739         -- No need to check for duplicate associated type decls
 740         -- since that is done by RnNames.extendGlobalRdrEnvRn
 741
 742         -- Check the signatures
 743         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 744         ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
 745         ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
 746                 -- Typechecker is responsible for checking that we only
 747                 -- give default-method bindings for things in this class.
 748                 -- The renamer *could* check this for class decls, but can't
 749                 -- for instance decls.
 750
 751         -- The newLocals call is tiresome: given a generic class decl
 752         --      class C a where
 753         --        op :: a -> a
 754         --        op {| x+y |} (Inl a) = ...
 755         --        op {| x+y |} (Inr b) = ...
 756         --        op {| a*b |} (a*b)   = ...
 757         -- we want to name both "x" tyvars with the same unique, so that they are
 758         -- easy to group together in the typechecker.
 759         ; (mbinds', meth_fvs)
 760             <- extendTyVarEnvForMethodBinds tyvars' $ do
 761             { name_env <- getLocalRdrEnv
 762             ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
 763                                                  not (unLoc tv `elemLocalRdrEnv` name_env) ]
 764                 -- No need to check for duplicate method signatures
 765                 -- since that is done by RnNames.extendGlobalRdrEnvRn
 766                 -- and the methods are already in scope
 767             ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
 768             ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
 769
 770   -- Haddock docs
 771         ; docs' <- mapM (wrapLocM rnDocDecl) docs
 772
 773         ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
 774                               tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
 775                               tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
 776
 777                   delFVs (map hsLTyVarName tyvars')     $
 778                   extractHsCtxtTyNames context'         `plusFV`
 779                   plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
 780                   hsSigsFVs sigs'                       `plusFV`
 781                   meth_fvs                              `plusFV`
 782                   ats_fvs) }
 783   where
 784     cls_doc  = text "In the declaration for class"      <+> ppr cname
 785     sig_doc  = text "In the signatures for class"       <+> ppr cname
 786
 787 badGadtStupidTheta :: Located RdrName -> SDoc
 788 badGadtStupidTheta _
 789   = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
 790           ptext (sLit "(You can put a context on each contructor, though.)")]
 791 \end{code}
 792
 793 %*********************************************************
 794 %*                                                      *
 795 \subsection{Support code for type/data declarations}
 796 %*                                                      *
 797 %*********************************************************
 798
 799 \begin{code}
 800 -- Remove any duplicate type variables in family instances may have non-linear
 801 -- left-hand sides.  Complain if any, but the first occurence of a type
 802 -- variable has a user-supplied kind signature.
 803 --
 804 pruneTyVars :: TyClDecl RdrName -> RnM [LHsTyVarBndr RdrName]
 805 pruneTyVars tydecl
 806   | isFamInstDecl tydecl
 807   = do { let pruned_tyvars = nubBy eqLTyVar tyvars
 808        ; assertNoSigsInRepeats tyvars
 809        ; return pruned_tyvars
 810        }
 811   | otherwise
 812   = return tyvars
 813   where
 814     tyvars = tcdTyVars tydecl
 815
 816     assertNoSigsInRepeats []       = return ()
 817     assertNoSigsInRepeats (tv:tvs)
 818       = do { let offending_tvs = [ tv' | tv'@(L _ (KindedTyVar _ _)) <- tvs
 819                                        , tv' `eqLTyVar` tv]
 820            ; checkErr (null offending_tvs) $
 821                illegalKindSig (head offending_tvs)
 822            ; assertNoSigsInRepeats tvs
 823            }
 824
 825     illegalKindSig tv
 826       = hsep [ptext (sLit "Repeat variable occurrence may not have a"),
 827               ptext (sLit "kind signature:"), quotes (ppr tv)]
 828
 829     tv1 `eqLTyVar` tv2 = hsLTyVarLocName tv1 `eqLocated` hsLTyVarLocName tv2
 830
 831 -- Although, we are processing type patterns here, all type variables will
 832 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
 833 -- type declaration to which these patterns belong)
 834 --
 835 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
 836 rnTyPats _   Nothing       = return Nothing
 837 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
 838
 839 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
 840 rnConDecls _tycon condecls
 841   = mappM (wrapLocM rnConDecl) condecls
 842
 843 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
 844 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
 845   = do  { addLocM checkConName name
 846
 847         ; new_name <- lookupLocatedTopBndrRn name
 848         ; name_env <- getLocalRdrEnv
 849
 850         -- For H98 syntax, the tvs are the existential ones
 851         -- For GADT syntax, the tvs are all the quantified tyvars
 852         -- Hence the 'filter' in the ResTyH98 case only
 853         ; let not_in_scope  = not . (`elemLocalRdrEnv` name_env) . unLoc
 854               arg_tys       = hsConDeclArgTys details
 855               implicit_tvs  = case res_ty of
 856                                 ResTyH98 -> filter not_in_scope $
 857                                                 get_rdr_tvs arg_tys
 858                                 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
 859               tvs' = case expl of
 860                         Explicit -> tvs
 861                         Implicit -> userHsTyVarBndrs implicit_tvs
 862
 863         ; mb_doc' <- rnMbLHsDoc mb_doc
 864
 865         ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
 866         { new_context <- rnContext doc cxt
 867         ; new_details <- rnConDeclDetails doc details
 868         ; (new_details', new_res_ty)  <- rnConResult doc new_details res_ty
 869         ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
 870  where
 871     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 872     get_rdr_tvs tys  = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
 873
 874 rnConResult :: SDoc
 875             -> HsConDetails (LHsType Name) [ConDeclField Name]
 876             -> ResType RdrName
 877             -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
 878                     ResType Name)
 879 rnConResult _ details ResTyH98 = return (details, ResTyH98)
 880
 881 rnConResult doc details (ResTyGADT ty) = do
 882     ty' <- rnHsSigType doc ty
 883     let (arg_tys, res_ty) = splitHsFunType ty'
 884         -- We can split it up, now the renamer has dealt with fixities
 885     case details of
 886         PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
 887         RecCon _ -> return (details, ResTyGADT ty')
 888         InfixCon {}   -> panic "rnConResult"
 889
 890 rnConDeclDetails :: SDoc
 891                  -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
 892                  -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
 893 rnConDeclDetails doc (PrefixCon tys)
 894   = mappM (rnLHsType doc) tys   `thenM` \ new_tys  ->
 895     returnM (PrefixCon new_tys)
 896
 897 rnConDeclDetails doc (InfixCon ty1 ty2)
 898   = rnLHsType doc ty1           `thenM` \ new_ty1 ->
 899     rnLHsType doc ty2           `thenM` \ new_ty2 ->
 900     returnM (InfixCon new_ty1 new_ty2)
 901
 902 rnConDeclDetails doc (RecCon fields)
 903   = do  { new_fields <- mappM (rnField doc) fields
 904                 -- No need to check for duplicate fields
 905                 -- since that is done by RnNames.extendGlobalRdrEnvRn
 906         ; return (RecCon new_fields) }
 907
 908 rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
 909 rnField doc (ConDeclField name ty haddock_doc)
 910   = lookupLocatedTopBndrRn name `thenM` \ new_name ->
 911     rnLHsType doc ty            `thenM` \ new_ty ->
 912     rnMbLHsDoc haddock_doc      `thenM` \ new_haddock_doc ->
 913     returnM (ConDeclField new_name new_ty new_haddock_doc)
 914
 915 -- Rename family declarations
 916 --
 917 -- * This function is parametrised by the routine handling the index
 918 --   variables.  On the toplevel, these are defining occurences, whereas they
 919 --   are usage occurences for associated types.
 920 --
 921 rnFamily :: TyClDecl RdrName
 922          -> (SDoc -> [LHsTyVarBndr RdrName] ->
 923              ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
 924              RnM (TyClDecl Name, FreeVars))
 925          -> RnM (TyClDecl Name, FreeVars)
 926
 927 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
 928                            tcdLName = tycon, tcdTyVars = tyvars})
 929         bindIdxVars =
 930       do { checkM (isDataFlavour flavour                      -- for synonyms,
 931                    || not (null tyvars)) $ addErr needOneIdx  -- no. of indexes >= 1
 932          ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
 933          ; tycon' <- lookupLocatedTopBndrRn tycon
 934          ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
 935                               tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
 936                     emptyFVs)
 937          } }
 938       where
 939         isDataFlavour DataFamily = True
 940         isDataFlavour _          = False
 941 rnFamily d _ = pprPanic "rnFamily" (ppr d)
 942
 943 family_doc :: Located RdrName -> SDoc
 944 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
 945
 946 needOneIdx :: SDoc
 947 needOneIdx = text "Type family declarations requires at least one type index"
 948
 949 -- Rename associated type declarations (in classes)
 950 --
 951 -- * This can be family declarations and (default) type instances
 952 --
 953 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
 954 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
 955   where
 956     rn_at (tydecl@TyFamily  {}) = rnFamily tydecl lookupIdxVars
 957     rn_at (tydecl@TySynonym {}) =
 958       do
 959         checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
 960         rnTyClDecl tydecl
 961     rn_at _                      = panic "RnSource.rnATs: invalid TyClDecl"
 962
 963     lookupIdxVars _ tyvars cont =
 964       do { checkForDups tyvars;
 965          ; tyvars' <- mappM lookupIdxVar tyvars
 966          ; cont tyvars'
 967          }
 968     -- Type index variables must be class parameters, which are the only
 969     -- type variables in scope at this point.
 970     lookupIdxVar (L l tyvar) =
 971       do
 972         name' <- lookupOccRn (hsTyVarName tyvar)
 973         return $ L l (replaceTyVarName tyvar name')
 974
 975     -- Type variable may only occur once.
 976     --
 977     checkForDups [] = return ()
 978     checkForDups (L loc tv:ltvs) =
 979       do { setSrcSpan loc $
 980              when (hsTyVarName tv `ltvElem` ltvs) $
 981                addErr (repeatedTyVar tv)
 982          ; checkForDups ltvs
 983          }
 984
 985     _       `ltvElem` [] = False
 986     rdrName `ltvElem` (L _ tv:ltvs)
 987       | rdrName == hsTyVarName tv = True
 988       | otherwise                 = rdrName `ltvElem` ltvs
 989
 990 noPatterns :: SDoc
 991 noPatterns = text "Default definition for an associated synonym cannot have"
 992              <+> text "type pattern"
 993
 994 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
 995 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
 996                    quotes (ppr tv)
 997
 998 -- This data decl will parse OK
 999 --      data T = a Int
1000 -- treating "a" as the constructor.
1001 -- It is really hard to make the parser spot this malformation.
1002 -- So the renamer has to check that the constructor is legal
1003 --
1004 -- We can get an operator as the constructor, even in the prefix form:
1005 --      data T = :% Int Int
1006 -- from interface files, which always print in prefix form
1007
1008 checkConName :: RdrName -> TcRn ()
1009 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1010
1011 badDataCon :: RdrName -> SDoc
1012 badDataCon name
1013    = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1014 \end{code}
1015
1016
1017 %*********************************************************
1018 %*                                                      *
1019 \subsection{Support code for type/data declarations}
1020 %*                                                      *
1021 %*********************************************************
1022
1023 Get the mapping from constructors to fields for this module.
1024 It's convenient to do this after the data type decls have been renamed
1025 \begin{code}
1026 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
1027 extendRecordFieldEnv decls
1028   = do  { tcg_env <- getGblEnv
1029         ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
1030         ; return (tcg_env { tcg_field_env = field_env' }) }
1031   where
1032     -- we want to lookup:
1033     --  (a) a datatype constructor
1034     --  (b) a record field
1035     -- knowing that they're from this module.
1036     -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1037     -- which keeps only the local ones.
1038     lookup x = do { x' <- lookupLocatedTopBndrRn x
1039                     ; return $ unLoc x'}
1040
1041     get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
1042     get _                            env = return env
1043
1044     get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
1045         = do { con' <- lookup con
1046             ; flds' <- mappM lookup (map cd_fld_name flds)
1047             ; return $ extendNameEnv env con' flds' }
1048     get_con _ env
1049         = return env
1050 \end{code}
1051
1052 %*********************************************************
1053 %*                                                      *
1054 \subsection{Support code to rename types}
1055 %*                                                      *
1056 %*********************************************************
1057
1058 \begin{code}
1059 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1060
1061 rnFds doc fds
1062   = mappM (wrapLocM rn_fds) fds
1063   where
1064     rn_fds (tys1, tys2)
1065       = rnHsTyVars doc tys1             `thenM` \ tys1' ->
1066         rnHsTyVars doc tys2             `thenM` \ tys2' ->
1067         returnM (tys1', tys2')
1068
1069 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1070 rnHsTyVars doc tvs  = mappM (rnHsTyVar doc) tvs
1071
1072 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1073 rnHsTyVar _doc tyvar = lookupOccRn tyvar
1074 \end{code}
1075
1076
1077 %*********************************************************
1078 %*                                                      *
1079                 Splices
1080 %*                                                      *
1081 %*********************************************************
1082
1083 Note [Splices]
1084 ~~~~~~~~~~~~~~
1085 Consider
1086         f = ...
1087         h = ...$(thing "f")...
1088
1089 The splice can expand into literally anything, so when we do dependency
1090 analysis we must assume that it might mention 'f'.  So we simply treat
1091 all locally-defined names as mentioned by any splice.  This is terribly
1092 brutal, but I don't see what else to do.  For example, it'll mean
1093 that every locally-defined thing will appear to be used, so no unused-binding
1094 warnings.  But if we miss the dependency, then we might typecheck 'h' before 'f',
1095 and that will crash the type checker because 'f' isn't in scope.
1096
1097 Currently, I'm not treating a splice as also mentioning every import,
1098 which is a bit inconsistent -- but there are a lot of them.  We might
1099 thereby get some bogus unused-import warnings, but we won't crash the
1100 type checker.  Not very satisfactory really.
1101
1102 \begin{code}
1103 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1104 rnSplice (HsSplice n expr)
1105   = do  { checkTH expr "splice"
1106         ; loc  <- getSrcSpanM
1107         ; [n'] <- newLocalsRn [L loc n]
1108         ; (expr', fvs) <- rnLExpr expr
1109
1110         -- Ugh!  See Note [Splices] above
1111         ; lcl_rdr <- getLocalRdrEnv
1112         ; gbl_rdr <- getGlobalRdrEnv
1113         ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1114                                                     isLocalGRE gre]
1115               lcl_names = mkNameSet (occEnvElts lcl_rdr)
1116
1117         ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1118
1119 checkTH :: Outputable a => a -> String -> RnM ()
1120 #ifdef GHCI
1121 checkTH _ _ = returnM ()        -- OK
1122 #else
1123 checkTH e what  -- Raise an error in a stage-1 compiler
1124   = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
1125                   ptext (sLit "illegal in a stage-1 compiler"),
1126                   nest 2 (ppr e)])
1127 #endif
1128 \end{code}