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