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, checkModDeprec,
  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, globalRdrEnvElts,
  19                           GlobalRdrElt(..), isLocalGRE )
  20 import RdrHsSyn         ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
  21 import RnHsSyn
  22 import RnTypes          ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
  23 import RnBinds          ( rnTopBinds, rnMethodBinds, renameSigs )
  24 import RnEnv            ( lookupLocalDataTcNames,
  25                           lookupLocatedTopBndrRn, lookupLocatedOccRn,
  26                           lookupOccRn, newLocalsRn,
  27                           bindLocatedLocalsFV, bindPatSigTyVarsFV,
  28                           bindTyVarsRn, extendTyVarEnvFVRn,
  29                           bindLocalNames, checkDupNames, mapFvRn
  30                         )
  31 import TcRnMonad
  32
  33 import HscTypes         ( FixityEnv, FixItem(..),
  34                           Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
  35 import Class            ( FunDep )
  36 import Name             ( Name, nameOccName )
  37 import NameSet
  38 import NameEnv
  39 import OccName          ( occEnvElts )
  40 import Outputable
  41 import SrcLoc           ( Located(..), unLoc, getLoc, noLoc )
  42 import DynFlags ( DynFlag(..) )
  43 import Maybes           ( seqMaybe )
  44 import Maybe            ( isNothing )
  45 import BasicTypes       ( Boxity(..) )
  46 \end{code}
  47
  48 @rnSourceDecl@ `renames' declarations.
  49 It simultaneously performs dependency analysis and precedence parsing.
  50 It also does the following error checks:
  51 \begin{enumerate}
  52 \item
  53 Checks that tyvars are used properly. This includes checking
  54 for undefined tyvars, and tyvars in contexts that are ambiguous.
  55 (Some of this checking has now been moved to module @TcMonoType@,
  56 since we don't have functional dependency information at this point.)
  57 \item
  58 Checks that all variable occurences are defined.
  59 \item
  60 Checks the @(..)@ etc constraints in the export list.
  61 \end{enumerate}
  62
  63
  64 \begin{code}
  65 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
  66
  67 rnSrcDecls (HsGroup { hs_valds  = val_decls,
  68                       hs_tyclds = tycl_decls,
  69                       hs_instds = inst_decls,
  70                       hs_fixds  = fix_decls,
  71                       hs_depds  = deprec_decls,
  72                       hs_fords  = foreign_decls,
  73                       hs_defds  = default_decls,
  74                       hs_ruleds = rule_decls })
  75
  76  = do {         -- Deal with deprecations (returns only the extra deprecations)
  77         deprecs <- rnSrcDeprecDecls deprec_decls ;
  78         updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
  79                   $ do {
  80
  81                 -- Deal with top-level fixity decls
  82                 -- (returns the total new fixity env)
  83         fix_env <- rnSrcFixityDeclsEnv fix_decls ;
  84         rn_fix_decls <- rnSrcFixityDecls fix_decls ;
  85         updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
  86                   $ do {
  87
  88                 -- Rename other declarations
  89         traceRn (text "Start rnmono") ;
  90         (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
  91         traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
  92
  93                 -- You might think that we could build proper def/use information
  94                 -- for type and class declarations, but they can be involved
  95                 -- in mutual recursion across modules, and we only do the SCC
  96                 -- analysis for them in the type checker.
  97                 -- So we content ourselves with gathering uses only; that
  98                 -- means we'll only report a declaration as unused if it isn't
  99                 -- mentioned at all.  Ah well.
 100         (rn_tycl_decls,    src_fvs1)
 101            <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
 102         (rn_inst_decls,    src_fvs2)
 103            <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
 104         (rn_rule_decls,    src_fvs3)
 105            <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
 106         (rn_foreign_decls, src_fvs4)
 107            <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
 108         (rn_default_decls, src_fvs5)
 109            <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
 110
 111         let {
 112            rn_group = HsGroup { hs_valds  = rn_val_decls,
 113                                 hs_tyclds = rn_tycl_decls,
 114                                 hs_instds = rn_inst_decls,
 115                                 hs_fixds  = rn_fix_decls,
 116                                 hs_depds  = [],
 117                                 hs_fords  = rn_foreign_decls,
 118                                 hs_defds  = rn_default_decls,
 119                                 hs_ruleds = rn_rule_decls } ;
 120
 121            other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3,
 122                                 src_fvs4, src_fvs5] ;
 123            src_dus = bind_dus `plusDU` usesOnly other_fvs
 124                 -- Note: src_dus will contain *uses* for locally-defined types
 125                 -- and classes, but no *defs* for them.  (Because rnTyClDecl
 126                 -- returns only the uses.)  This is a little
 127                 -- surprising but it doesn't actually matter at all.
 128         } ;
 129
 130         traceRn (text "finish rnSrc" <+> ppr rn_group) ;
 131         traceRn (text "finish Dus" <+> ppr src_dus ) ;
 132         tcg_env <- getGblEnv ;
 133         return (tcg_env `addTcgDUs` src_dus, rn_group)
 134     }}}
 135
 136 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
 137 rnTyClDecls tycl_decls = do
 138   (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
 139   return decls'
 140
 141 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
 142 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
 143 \end{code}
 144
 145
 146 %*********************************************************
 147 %*                                                       *
 148         Source-code fixity declarations
 149 %*                                                       *
 150 %*********************************************************
 151
 152 \begin{code}
 153 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
 154 rnSrcFixityDecls fix_decls
 155     = do fix_decls <- mapM rnFixityDecl fix_decls
 156          return (concat fix_decls)
 157
 158 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
 159 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
 160     = do names <- lookupLocalDataTcNames rdr_name
 161          return [ L loc (FixitySig (L nameLoc name) fixity)
 162                       | name <- names ]
 163
 164 rnSrcFixityDeclsEnv :: [LFixitySig RdrName] -> RnM FixityEnv
 165 rnSrcFixityDeclsEnv fix_decls
 166   = getGblEnv                                   `thenM` \ gbl_env ->
 167     foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
 168             fix_decls                                   `thenM` \ fix_env ->
 169     traceRn (text "fixity env" <+> pprFixEnv fix_env)   `thenM_`
 170     returnM fix_env
 171
 172 rnFixityDeclEnv :: FixityEnv -> LFixitySig RdrName -> RnM FixityEnv
 173 rnFixityDeclEnv fix_env (L loc (FixitySig rdr_name fixity))
 174   = setSrcSpan loc $
 175         -- GHC extension: look up both the tycon and data con
 176         -- for con-like things
 177         -- If neither are in scope, report an error; otherwise
 178         -- add both to the fixity env
 179      addLocM lookupLocalDataTcNames rdr_name    `thenM` \ names ->
 180      foldlM add fix_env names
 181   where
 182     add fix_env name
 183       = case lookupNameEnv fix_env name of
 184           Just (FixItem _ _ loc')
 185                   -> addLocErr rdr_name (dupFixityDecl loc')    `thenM_`
 186                      returnM fix_env
 187           Nothing -> returnM (extendNameEnv fix_env name fix_item)
 188       where
 189         fix_item = FixItem (nameOccName name) fixity (getLoc rdr_name)
 190
 191 pprFixEnv :: FixityEnv -> SDoc
 192 pprFixEnv env
 193   = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
 194                   (nameEnvElts env)
 195
 196 dupFixityDecl loc rdr_name
 197   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 198           ptext SLIT("also at ") <+> ppr loc
 199         ]
 200 \end{code}
 201
 202
 203 %*********************************************************
 204 %*                                                       *
 205         Source-code deprecations declarations
 206 %*                                                       *
 207 %*********************************************************
 208
 209 For deprecations, all we do is check that the names are in scope.
 210 It's only imported deprecations, dealt with in RnIfaces, that we
 211 gather them together.
 212
 213 \begin{code}
 214 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
 215 rnSrcDeprecDecls []
 216   = returnM NoDeprecs
 217
 218 rnSrcDeprecDecls decls
 219   = mappM (addLocM rn_deprec) decls     `thenM` \ pairs_s ->
 220     returnM (DeprecSome (mkNameEnv (concat pairs_s)))
 221  where
 222    rn_deprec (Deprecation rdr_name txt)
 223      = lookupLocalDataTcNames rdr_name  `thenM` \ names ->
 224        returnM [(name, (nameOccName name, txt)) | name <- names]
 225
 226 checkModDeprec :: Maybe DeprecTxt -> Deprecations
 227 -- Check for a module deprecation; done once at top level
 228 checkModDeprec Nothing    = NoDeprecs
 229 checkModDeprec (Just txt) = DeprecAll txt
 230 \end{code}
 231
 232 %*********************************************************
 233 %*                                                      *
 234 \subsection{Source code declarations}
 235 %*                                                      *
 236 %*********************************************************
 237
 238 \begin{code}
 239 rnDefaultDecl (DefaultDecl tys)
 240   = mapFvRn (rnHsTypeFVs doc_str) tys   `thenM` \ (tys', fvs) ->
 241     returnM (DefaultDecl tys', fvs)
 242   where
 243     doc_str = text "In a `default' declaration"
 244 \end{code}
 245
 246 %*********************************************************
 247 %*                                                      *
 248 \subsection{Foreign declarations}
 249 %*                                                      *
 250 %*********************************************************
 251
 252 \begin{code}
 253 rnHsForeignDecl (ForeignImport name ty spec isDeprec)
 254   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
 255     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
 256     returnM (ForeignImport name' ty' spec isDeprec, fvs)
 257
 258 rnHsForeignDecl (ForeignExport name ty spec isDeprec)
 259   = lookupLocatedOccRn name             `thenM` \ name' ->
 260     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
 261     returnM (ForeignExport name' ty' spec isDeprec, fvs )
 262         -- NB: a foreign export is an *occurrence site* for name, so
 263         --     we add it to the free-variable list.  It might, for example,
 264         --     be imported from another module
 265
 266 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
 267 \end{code}
 268
 269
 270 %*********************************************************
 271 %*                                                      *
 272 \subsection{Instance declarations}
 273 %*                                                      *
 274 %*********************************************************
 275
 276 \begin{code}
 277 rnSrcInstDecl (InstDecl inst_ty mbinds uprags)
 278         -- Used for both source and interface file decls
 279   = rnHsSigType (text "an instance decl") inst_ty       `thenM` \ inst_ty' ->
 280
 281         -- Rename the bindings
 282         -- The typechecker (not the renamer) checks that all
 283         -- the bindings are for the right class
 284     let
 285         meth_doc    = text "In the bindings in an instance declaration"
 286         meth_names  = collectHsBindLocatedBinders mbinds
 287         (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
 288     in
 289     checkDupNames meth_doc meth_names   `thenM_`
 290     extendTyVarEnvForMethodBinds inst_tyvars (
 291         -- (Slightly strangely) the forall-d tyvars scope over
 292         -- the method bindings too
 293         rnMethodBinds cls [] mbinds
 294     )                                           `thenM` \ (mbinds', meth_fvs) ->
 295         -- Rename the prags and signatures.
 296         -- Note that the type variables are not in scope here,
 297         -- so that      instance Eq a => Eq (T a) where
 298         --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
 299         -- works OK.
 300         --
 301         -- But the (unqualified) method names are in scope
 302     let
 303         binders = collectHsBindBinders mbinds'
 304         ok_sig  = okInstDclSig (mkNameSet binders)
 305     in
 306     bindLocalNames binders (renameSigs ok_sig uprags)   `thenM` \ uprags' ->
 307
 308     returnM (InstDecl inst_ty' mbinds' uprags',
 309              meth_fvs `plusFV` hsSigsFVs uprags'
 310                       `plusFV` extractHsTyNames inst_ty')
 311 \end{code}
 312
 313 For the method bindings in class and instance decls, we extend the
 314 type variable environment iff -fglasgow-exts
 315
 316 \begin{code}
 317 extendTyVarEnvForMethodBinds tyvars thing_inside
 318   = doptM Opt_GlasgowExts                       `thenM` \ opt_GlasgowExts ->
 319     if opt_GlasgowExts then
 320         extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
 321     else
 322         thing_inside
 323 \end{code}
 324
 325
 326 %*********************************************************
 327 %*                                                      *
 328 \subsection{Rules}
 329 %*                                                      *
 330 %*********************************************************
 331
 332 \begin{code}
 333 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
 334   = bindPatSigTyVarsFV (collectRuleBndrSigTys vars)     $
 335
 336     bindLocatedLocalsFV doc (map get_var vars)          $ \ ids ->
 337     mapFvRn rn_var (vars `zip` ids)             `thenM` \ (vars', fv_vars) ->
 338
 339     rnLExpr lhs                                 `thenM` \ (lhs', fv_lhs') ->
 340     rnLExpr rhs                                 `thenM` \ (rhs', fv_rhs') ->
 341     let
 342         mb_bad = validRuleLhs ids lhs'
 343     in
 344     checkErr (isNothing mb_bad)
 345              (badRuleLhsErr rule_name lhs' mb_bad)      `thenM_`
 346     let
 347         bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
 348     in
 349     mappM (addErr . badRuleVar rule_name) bad_vars      `thenM_`
 350     returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
 351              fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
 352   where
 353     doc = text "In the transformation rule" <+> ftext rule_name
 354
 355     get_var (RuleBndr v)      = v
 356     get_var (RuleBndrSig v _) = v
 357
 358     rn_var (RuleBndr (L loc v), id)
 359         = returnM (RuleBndr (L loc id), emptyFVs)
 360     rn_var (RuleBndrSig (L loc v) t, id)
 361         = rnHsTypeFVs doc t     `thenM` \ (t', fvs) ->
 362           returnM (RuleBndrSig (L loc id) t', fvs)
 363 \end{code}
 364
 365 Check the shape of a transformation rule LHS.  Currently
 366 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
 367 not one of the @forall@'d variables.  We also restrict the form of the LHS so
 368 that it may be plausibly matched.  Basically you only get to write ordinary
 369 applications.  (E.g. a case expression is not allowed: too elaborate.)
 370
 371 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
 372
 373 \begin{code}
 374 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
 375 -- Nothing => OK
 376 -- Just e  => Not ok, and e is the offending expression
 377 validRuleLhs foralls lhs
 378   = checkl lhs
 379   where
 380     checkl (L loc e) = check e
 381
 382     check (OpApp e1 op _ e2)              = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
 383     check (HsApp e1 e2)                   = checkl e1 `seqMaybe` checkl_e e2
 384     check (HsVar v) | v `notElem` foralls = Nothing
 385     check other                           = Just other  -- Failure
 386
 387     checkl_e (L loc e) = check_e e
 388
 389     check_e (HsVar v)     = Nothing
 390     check_e (HsPar e)     = checkl_e e
 391     check_e (HsLit e)     = Nothing
 392     check_e (HsOverLit e) = Nothing
 393
 394     check_e (OpApp e1 op _ e2)   = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
 395     check_e (HsApp e1 e2)        = checkl_e e1 `seqMaybe` checkl_e e2
 396     check_e (NegApp e _)         = checkl_e e
 397     check_e (ExplicitList _ es)  = checkl_es es
 398     check_e (ExplicitTuple es _) = checkl_es es
 399     check_e other                = Just other   -- Fails
 400
 401     checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
 402
 403 badRuleLhsErr name lhs (Just bad_e)
 404   = sep [ptext SLIT("Rule") <+> ftext name <> colon,
 405          nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
 406                        ptext SLIT("in left-hand side:") <+> ppr lhs])]
 407     $$
 408     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
 409
 410 badRuleVar name var
 411   = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
 412          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
 413                 ptext SLIT("does not appear on left hand side")]
 414 \end{code}
 415
 416
 417 %*********************************************************
 418 %*                                                      *
 419 \subsection{Type, class and iface sig declarations}
 420 %*                                                      *
 421 %*********************************************************
 422
 423 @rnTyDecl@ uses the `global name function' to create a new type
 424 declaration in which local names have been replaced by their original
 425 names, reporting any unknown names.
 426
 427 Renaming type variables is a pain. Because they now contain uniques,
 428 it is necessary to pass in an association list which maps a parsed
 429 tyvar to its @Name@ representation.
 430 In some cases (type signatures of values),
 431 it is even necessary to go over the type first
 432 in order to get the set of tyvars used by it, make an assoc list,
 433 and then go over it again to rename the tyvars!
 434 However, we can also do some scoping checks at the same time.
 435
 436 \begin{code}
 437 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
 438   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
 439     returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
 440              emptyFVs)
 441
 442 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
 443                     tcdTyVars = tyvars, tcdCons = condecls,
 444                     tcdKindSig = sig, tcdDerivs = derivs})
 445   | is_vanilla  -- Normal Haskell data type decl
 446   = ASSERT( isNothing sig )     -- In normal H98 form, kind signature on the
 447                                 -- data type is syntactically illegal
 448     bindTyVarsRn data_doc tyvars                $ \ tyvars' ->
 449     do  { tycon' <- lookupLocatedTopBndrRn tycon
 450         ; context' <- rnContext data_doc context
 451         ; (derivs', deriv_fvs) <- rn_derivs derivs
 452         ; checkDupNames data_doc con_names
 453         ; condecls' <- rnConDecls (unLoc tycon') condecls
 454         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
 455                            tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls',
 456                            tcdDerivs = derivs'},
 457                    delFVs (map hsLTyVarName tyvars')    $
 458                    extractHsCtxtTyNames context'        `plusFV`
 459                    plusFVs (map conDeclFVs condecls') `plusFV`
 460                    deriv_fvs) }
 461
 462   | otherwise   -- GADT
 463   = do  { tycon' <- lookupLocatedTopBndrRn tycon
 464         ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
 465         ; tyvars' <- bindTyVarsRn data_doc tyvars
 466                                   (\ tyvars' -> return tyvars')
 467                 -- For GADTs, the type variables in the declaration
 468                 -- do not scope over the constructor signatures
 469                 --      data T a where { T1 :: forall b. b-> b }
 470         ; (derivs', deriv_fvs) <- rn_derivs derivs
 471         ; checkDupNames data_doc con_names
 472         ; condecls' <- rnConDecls (unLoc tycon') condecls
 473         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
 474                            tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
 475                            tcdDerivs = derivs'},
 476                    plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
 477
 478   where
 479     is_vanilla = case condecls of       -- Yuk
 480                      []                    -> True
 481                      L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
 482                      other                 -> False
 483
 484     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 485     con_names = map con_names_helper condecls
 486
 487     con_names_helper (L _ c) = con_name c
 488
 489     rn_derivs Nothing   = returnM (Nothing, emptyFVs)
 490     rn_derivs (Just ds) = rnLHsTypes data_doc ds        `thenM` \ ds' ->
 491                           returnM (Just ds', extractHsTyNames_s ds')
 492
 493 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
 494   = lookupLocatedTopBndrRn name                 `thenM` \ name' ->
 495     bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
 496     rnHsTypeFVs syn_doc ty                      `thenM` \ (ty', fvs) ->
 497     returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
 498                         tcdSynRhs = ty'},
 499              delFVs (map hsLTyVarName tyvars') fvs)
 500   where
 501     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 502
 503 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
 504                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 505                        tcdMeths = mbinds})
 506   = lookupLocatedTopBndrRn cname                `thenM` \ cname' ->
 507
 508         -- Tyvars scope over superclass context and method signatures
 509     bindTyVarsRn cls_doc tyvars                 ( \ tyvars' ->
 510         rnContext cls_doc context       `thenM` \ context' ->
 511         rnFds cls_doc fds               `thenM` \ fds' ->
 512         renameSigs okClsDclSig sigs     `thenM` \ sigs' ->
 513         returnM   (tyvars', context', fds', sigs')
 514     )   `thenM` \ (tyvars', context', fds', sigs') ->
 515
 516         -- Check the signatures
 517         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 518     let
 519         sig_rdr_names_w_locs   = [op | L _ (TypeSig op _) <- sigs]
 520     in
 521     checkDupNames sig_doc sig_rdr_names_w_locs  `thenM_`
 522         -- Typechecker is responsible for checking that we only
 523         -- give default-method bindings for things in this class.
 524         -- The renamer *could* check this for class decls, but can't
 525         -- for instance decls.
 526
 527         -- The newLocals call is tiresome: given a generic class decl
 528         --      class C a where
 529         --        op :: a -> a
 530         --        op {| x+y |} (Inl a) = ...
 531         --        op {| x+y |} (Inr b) = ...
 532         --        op {| a*b |} (a*b)   = ...
 533         -- we want to name both "x" tyvars with the same unique, so that they are
 534         -- easy to group together in the typechecker.
 535     extendTyVarEnvForMethodBinds tyvars' (
 536          getLocalRdrEnv                                 `thenM` \ name_env ->
 537          let
 538              meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
 539              gen_rdr_tyvars_w_locs =
 540                 [ tv | tv <- extractGenericPatTyVars mbinds,
 541                       not (unLoc tv `elemLocalRdrEnv` name_env) ]
 542          in
 543          checkDupNames meth_doc meth_rdr_names_w_locs   `thenM_`
 544          newLocalsRn gen_rdr_tyvars_w_locs      `thenM` \ gen_tyvars ->
 545          rnMethodBinds (unLoc cname') gen_tyvars mbinds
 546     ) `thenM` \ (mbinds', meth_fvs) ->
 547
 548     returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
 549                          tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
 550              delFVs (map hsLTyVarName tyvars')  $
 551              extractHsCtxtTyNames context'          `plusFV`
 552              plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
 553              hsSigsFVs sigs'                        `plusFV`
 554              meth_fvs)
 555   where
 556     meth_doc = text "In the default-methods for class"  <+> ppr cname
 557     cls_doc  = text "In the declaration for class"      <+> ppr cname
 558     sig_doc  = text "In the signatures for class"       <+> ppr cname
 559
 560 badGadtStupidTheta tycon
 561   = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
 562           ptext SLIT("(You can put a context on each contructor, though.)")]
 563 \end{code}
 564
 565 %*********************************************************
 566 %*                                                      *
 567 \subsection{Support code for type/data declarations}
 568 %*                                                      *
 569 %*********************************************************
 570
 571 \begin{code}
 572 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
 573 rnConDecls tycon condecls
 574   = mappM (wrapLocM rnConDecl) condecls
 575
 576 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
 577 rnConDecl (ConDecl name expl tvs cxt details res_ty)
 578   = do  { addLocM checkConName name
 579
 580         ; new_name <- lookupLocatedTopBndrRn name
 581         ; name_env <- getLocalRdrEnv
 582
 583         -- For H98 syntax, the tvs are the existential ones
 584         -- For GADT syntax, the tvs are all the quantified tyvars
 585         -- Hence the 'filter' in the ResTyH98 case only
 586         ; let not_in_scope  = not . (`elemLocalRdrEnv` name_env) . unLoc
 587               arg_tys       = hsConArgs details
 588               implicit_tvs  = case res_ty of
 589                                 ResTyH98 -> filter not_in_scope $
 590                                                 get_rdr_tvs arg_tys
 591                                 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
 592               tvs' = case expl of
 593                         Explicit -> tvs
 594                         Implicit -> userHsTyVarBndrs implicit_tvs
 595
 596         ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
 597         { new_context <- rnContext doc cxt
 598         ; new_details <- rnConDetails doc details
 599         ; new_res_ty  <- rnConResult doc res_ty
 600         ; let rv = ConDecl new_name expl new_tyvars new_context new_details new_res_ty
 601         ; traceRn (text "****** - autrijus" <> ppr rv)
 602         ; return rv } }
 603   where
 604     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 605     get_rdr_tvs tys  = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
 606
 607 rnConResult _ ResTyH98 = return ResTyH98
 608 rnConResult doc (ResTyGADT ty) = do
 609     ty' <- rnHsSigType doc ty
 610     return $ ResTyGADT ty'
 611
 612 rnConDetails doc (PrefixCon tys)
 613   = mappM (rnLHsType doc) tys   `thenM` \ new_tys  ->
 614     returnM (PrefixCon new_tys)
 615
 616 rnConDetails doc (InfixCon ty1 ty2)
 617   = rnLHsType doc ty1           `thenM` \ new_ty1 ->
 618     rnLHsType doc ty2           `thenM` \ new_ty2 ->
 619     returnM (InfixCon new_ty1 new_ty2)
 620
 621 rnConDetails doc (RecCon fields)
 622   = checkDupNames doc field_names       `thenM_`
 623     mappM (rnField doc) fields          `thenM` \ new_fields ->
 624     returnM (RecCon new_fields)
 625   where
 626     field_names = [fld | (fld, _) <- fields]
 627
 628 rnField doc (name, ty)
 629   = lookupLocatedTopBndrRn name `thenM` \ new_name ->
 630     rnLHsType doc ty            `thenM` \ new_ty ->
 631     returnM (new_name, new_ty)
 632
 633 -- This data decl will parse OK
 634 --      data T = a Int
 635 -- treating "a" as the constructor.
 636 -- It is really hard to make the parser spot this malformation.
 637 -- So the renamer has to check that the constructor is legal
 638 --
 639 -- We can get an operator as the constructor, even in the prefix form:
 640 --      data T = :% Int Int
 641 -- from interface files, which always print in prefix form
 642
 643 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
 644
 645 badDataCon name
 646    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 647 \end{code}
 648
 649
 650 %*********************************************************
 651 %*                                                      *
 652 \subsection{Support code to rename types}
 653 %*                                                      *
 654 %*********************************************************
 655
 656 \begin{code}
 657 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
 658
 659 rnFds doc fds
 660   = mappM (wrapLocM rn_fds) fds
 661   where
 662     rn_fds (tys1, tys2)
 663       = rnHsTyVars doc tys1             `thenM` \ tys1' ->
 664         rnHsTyVars doc tys2             `thenM` \ tys2' ->
 665         returnM (tys1', tys2')
 666
 667 rnHsTyVars doc tvs  = mappM (rnHsTyvar doc) tvs
 668 rnHsTyvar doc tyvar = lookupOccRn tyvar
 669 \end{code}
 670
 671
 672 %*********************************************************
 673 %*                                                      *
 674                 Splices
 675 %*                                                      *
 676 %*********************************************************
 677
 678 Note [Splices]
 679 ~~~~~~~~~~~~~~
 680 Consider
 681         f = ...
 682         h = ...$(thing "f")...
 683
 684 The splice can expand into literally anything, so when we do dependency
 685 analysis we must assume that it might mention 'f'.  So we simply treat
 686 all locally-defined names as mentioned by any splice.  This is terribly
 687 brutal, but I don't see what else to do.  For example, it'll mean
 688 that every locally-defined thing will appear to be used, so no unused-binding
 689 warnings.  But if we miss the dependency, then we might typecheck 'h' before 'f',
 690 and that will crash the type checker because 'f' isn't in scope.
 691
 692 Currently, I'm not treating a splice as also mentioning every import,
 693 which is a bit inconsistent -- but there are a lot of them.  We might
 694 thereby get some bogus unused-import warnings, but we won't crash the
 695 type checker.  Not very satisfactory really.
 696
 697 \begin{code}
 698 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
 699 rnSplice (HsSplice n expr)
 700   = do  { checkTH expr "splice"
 701         ; loc  <- getSrcSpanM
 702         ; [n'] <- newLocalsRn [L loc n]
 703         ; (expr', fvs) <- rnLExpr expr
 704
 705         -- Ugh!  See Note [Splices] above
 706         ; lcl_rdr <- getLocalRdrEnv
 707         ; gbl_rdr <- getGlobalRdrEnv
 708         ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
 709                                                     isLocalGRE gre]
 710               lcl_names = mkNameSet (occEnvElts lcl_rdr)
 711
 712         ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
 713
 714 #ifdef GHCI
 715 checkTH e what = returnM ()     -- OK
 716 #else
 717 checkTH e what  -- Raise an error in a stage-1 compiler
 718   = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
 719                   ptext SLIT("illegal in a stage-1 compiler"),
 720                   nest 2 (ppr e)])
 721 #endif
 722 \end{code}