compiler/rename/RnSource.lhs

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