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,
  19                           globalRdrEnvElts, GlobalRdrElt(..), isLocalGRE )
  20 import RdrHsSyn         ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
  21 import RnHsSyn
  22 import RnTypes          ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
  23 import RnBinds          ( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn )
  24 import RnEnv            ( lookupLocalDataTcNames,
  25                           lookupLocatedTopBndrRn, lookupLocatedOccRn,
  26                           lookupOccRn, lookupTopBndrRn, newLocalsRn,
  27                           bindLocatedLocalsFV, bindPatSigTyVarsFV,
  28                           bindTyVarsRn, extendTyVarEnvFVRn,
  29                           bindLocalNames, checkDupNames, mapFvRn
  30                         )
  31 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
  32 import TcRnMonad
  33
  34 import HscTypes         ( FixityEnv, FixItem(..),
  35                           Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
  36 import Class            ( FunDep )
  37 import Name             ( Name, nameOccName )
  38 import NameSet
  39 import NameEnv
  40 import OccName          ( occEnvElts )
  41 import Outputable
  42 import SrcLoc           ( Located(..), unLoc, noLoc )
  43 import DynFlags ( DynFlag(..) )
  44 import Maybes           ( seqMaybe )
  45 import Maybe            ( isNothing, isJust )
  46 import Monad            ( liftM, when )
  47 import BasicTypes       ( Boxity(..) )
  48 \end{code}
  49
  50 @rnSourceDecl@ `renames' declarations.
  51 It simultaneously performs dependency analysis and precedence parsing.
  52 It also does the following error checks:
  53 \begin{enumerate}
  54 \item
  55 Checks that tyvars are used properly. This includes checking
  56 for undefined tyvars, and tyvars in contexts that are ambiguous.
  57 (Some of this checking has now been moved to module @TcMonoType@,
  58 since we don't have functional dependency information at this point.)
  59 \item
  60 Checks that all variable occurences are defined.
  61 \item
  62 Checks the @(..)@ etc constraints in the export list.
  63 \end{enumerate}
  64
  65
  66 \begin{code}
  67 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
  68
  69 rnSrcDecls (HsGroup { hs_valds  = val_decls,
  70                       hs_tyclds = tycl_decls,
  71                       hs_instds = inst_decls,
  72                       hs_derivds = deriv_decls,
  73                       hs_fixds  = fix_decls,
  74                       hs_depds  = deprec_decls,
  75                       hs_fords  = foreign_decls,
  76                       hs_defds  = default_decls,
  77                       hs_ruleds = rule_decls,
  78                       hs_docs   = docs })
  79
  80  = do {         -- Deal with deprecations (returns only the extra deprecations)
  81         deprecs <- rnSrcDeprecDecls deprec_decls ;
  82         updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
  83                   $ do {
  84
  85                 -- Deal with top-level fixity decls
  86                 -- (returns the total new fixity env)
  87         rn_fix_decls <- rnSrcFixityDecls fix_decls ;
  88         fix_env <- rnSrcFixityDeclsEnv rn_fix_decls ;
  89         updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
  90                   $ do {
  91
  92                 -- Rename other declarations
  93         traceRn (text "Start rnmono") ;
  94         (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
  95         traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
  96
  97                 -- You might think that we could build proper def/use information
  98                 -- for type and class declarations, but they can be involved
  99                 -- in mutual recursion across modules, and we only do the SCC
 100                 -- analysis for them in the type checker.
 101                 -- So we content ourselves with gathering uses only; that
 102                 -- means we'll only report a declaration as unused if it isn't
 103                 -- mentioned at all.  Ah well.
 104         (rn_tycl_decls,    src_fvs1)
 105            <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
 106         (rn_inst_decls,    src_fvs2)
 107            <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
 108         (rn_deriv_decls,    src_fvs_deriv)
 109            <- mapFvRn (wrapLocFstM rnSrcDerivDecl) deriv_decls ;
 110         (rn_rule_decls,    src_fvs3)
 111            <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
 112         (rn_foreign_decls, src_fvs4)
 113            <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
 114         (rn_default_decls, src_fvs5)
 115            <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
 116
 117         rn_docs <- mapM rnDocEntity docs ;
 118
 119         let {
 120            rn_group = HsGroup { hs_valds  = rn_val_decls,
 121                                 hs_tyclds = rn_tycl_decls,
 122                                 hs_instds = rn_inst_decls,
 123                                 hs_derivds = rn_deriv_decls,
 124                                 hs_fixds  = rn_fix_decls,
 125                                 hs_depds  = [],
 126                                 hs_fords  = rn_foreign_decls,
 127                                 hs_defds  = rn_default_decls,
 128                                 hs_ruleds = rn_rule_decls,
 129                                 hs_docs   = rn_docs } ;
 130
 131            other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs_deriv, src_fvs3,
 132                                 src_fvs4, src_fvs5] ;
 133            src_dus = bind_dus `plusDU` usesOnly other_fvs
 134                 -- Note: src_dus will contain *uses* for locally-defined types
 135                 -- and classes, but no *defs* for them.  (Because rnTyClDecl
 136                 -- returns only the uses.)  This is a little
 137                 -- surprising but it doesn't actually matter at all.
 138         } ;
 139
 140         traceRn (text "finish rnSrc" <+> ppr rn_group) ;
 141         traceRn (text "finish Dus" <+> ppr src_dus ) ;
 142         tcg_env <- getGblEnv ;
 143         return (tcg_env `addTcgDUs` src_dus, rn_group)
 144     }}}
 145
 146 rnDocEntity :: DocEntity RdrName -> RnM (DocEntity Name)
 147 rnDocEntity (DocEntity docdecl) = do
 148   rn_docdecl <- rnDocDecl docdecl
 149   return (DocEntity rn_docdecl)
 150 rnDocEntity (DeclEntity name) = do
 151   rn_name <- lookupTopBndrRn name
 152   return (DeclEntity rn_name)
 153
 154 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
 155 rnDocDecl (DocCommentNext doc) = do
 156   rn_doc <- rnHsDoc doc
 157   return (DocCommentNext rn_doc)
 158 rnDocDecl (DocCommentPrev doc) = do
 159   rn_doc <- rnHsDoc doc
 160   return (DocCommentPrev rn_doc)
 161 rnDocDecl (DocCommentNamed str doc) = do
 162   rn_doc <- rnHsDoc doc
 163   return (DocCommentNamed str rn_doc)
 164 rnDocDecl (DocGroup lev doc) = do
 165   rn_doc <- rnHsDoc doc
 166   return (DocGroup lev rn_doc)
 167
 168 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
 169 rnTyClDecls tycl_decls = do
 170   (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
 171   return decls'
 172
 173 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
 174 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
 175 \end{code}
 176
 177
 178 %*********************************************************
 179 %*                                                       *
 180         Source-code fixity declarations
 181 %*                                                       *
 182 %*********************************************************
 183
 184 \begin{code}
 185 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
 186 rnSrcFixityDecls fix_decls
 187     = do fix_decls <- mapM rnFixityDecl fix_decls
 188          return (concat fix_decls)
 189
 190 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
 191 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
 192     = setSrcSpan nameLoc $
 193         -- GHC extension: look up both the tycon and data con
 194         -- for con-like things
 195         -- If neither are in scope, report an error; otherwise
 196         -- add both to the fixity env
 197       do names <- lookupLocalDataTcNames rdr_name
 198          return [ L loc (FixitySig (L nameLoc name) fixity)
 199                       | name <- names ]
 200
 201 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
 202 rnSrcFixityDeclsEnv fix_decls
 203   = getGblEnv                                   `thenM` \ gbl_env ->
 204     foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
 205             fix_decls                                   `thenM` \ fix_env ->
 206     traceRn (text "fixity env" <+> pprFixEnv fix_env)   `thenM_`
 207     returnM fix_env
 208
 209 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
 210 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
 211   = case lookupNameEnv fix_env name of
 212       Just (FixItem _ _ loc')
 213           -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
 214                 return fix_env
 215       Nothing
 216           -> return (extendNameEnv fix_env name fix_item)
 217     where fix_item = FixItem (nameOccName name) fixity nameLoc
 218
 219 pprFixEnv :: FixityEnv -> SDoc
 220 pprFixEnv env
 221   = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
 222                   (nameEnvElts env)
 223
 224 dupFixityDecl loc rdr_name
 225   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 226           ptext SLIT("also at ") <+> ppr loc
 227         ]
 228 \end{code}
 229
 230
 231 %*********************************************************
 232 %*                                                       *
 233         Source-code deprecations declarations
 234 %*                                                       *
 235 %*********************************************************
 236
 237 For deprecations, all we do is check that the names are in scope.
 238 It's only imported deprecations, dealt with in RnIfaces, that we
 239 gather them together.
 240
 241 \begin{code}
 242 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
 243 rnSrcDeprecDecls []
 244   = returnM NoDeprecs
 245
 246 rnSrcDeprecDecls decls
 247   = mappM (addLocM rn_deprec) decls     `thenM` \ pairs_s ->
 248     returnM (DeprecSome (mkNameEnv (concat pairs_s)))
 249  where
 250    rn_deprec (Deprecation rdr_name txt)
 251      = lookupLocalDataTcNames rdr_name  `thenM` \ names ->
 252        returnM [(name, (nameOccName name, txt)) | name <- names]
 253
 254 checkModDeprec :: Maybe DeprecTxt -> Deprecations
 255 -- Check for a module deprecation; done once at top level
 256 checkModDeprec Nothing    = NoDeprecs
 257 checkModDeprec (Just txt) = DeprecAll txt
 258 \end{code}
 259
 260 %*********************************************************
 261 %*                                                      *
 262 \subsection{Source code declarations}
 263 %*                                                      *
 264 %*********************************************************
 265
 266 \begin{code}
 267 rnDefaultDecl (DefaultDecl tys)
 268   = mapFvRn (rnHsTypeFVs doc_str) tys   `thenM` \ (tys', fvs) ->
 269     returnM (DefaultDecl tys', fvs)
 270   where
 271     doc_str = text "In a `default' declaration"
 272 \end{code}
 273
 274 %*********************************************************
 275 %*                                                      *
 276 \subsection{Foreign declarations}
 277 %*                                                      *
 278 %*********************************************************
 279
 280 \begin{code}
 281 rnHsForeignDecl (ForeignImport name ty spec)
 282   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
 283     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
 284     returnM (ForeignImport name' ty' spec, fvs)
 285
 286 rnHsForeignDecl (ForeignExport name ty spec)
 287   = lookupLocatedOccRn name             `thenM` \ name' ->
 288     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
 289     returnM (ForeignExport name' ty' spec, fvs )
 290         -- NB: a foreign export is an *occurrence site* for name, so
 291         --     we add it to the free-variable list.  It might, for example,
 292         --     be imported from another module
 293
 294 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
 295 \end{code}
 296
 297
 298 %*********************************************************
 299 %*                                                      *
 300 \subsection{Instance declarations}
 301 %*                                                      *
 302 %*********************************************************
 303
 304 \begin{code}
 305 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
 306         -- Used for both source and interface file decls
 307   = rnHsSigType (text "an instance decl") inst_ty       `thenM` \ inst_ty' ->
 308
 309         -- Rename the associated types
 310         -- The typechecker (not the renamer) checks that all
 311         -- the declarations are for the right class
 312     let
 313         at_doc   = text "In the associated types of an instance declaration"
 314         at_names = map (head . tyClDeclNames . unLoc) ats
 315     in
 316     checkDupNames at_doc at_names               `thenM_`
 317     rnATInsts ats                               `thenM` \ (ats', at_fvs) ->
 318
 319         -- Rename the bindings
 320         -- The typechecker (not the renamer) checks that all
 321         -- the bindings are for the right class
 322     let
 323         meth_doc    = text "In the bindings in an instance declaration"
 324         meth_names  = collectHsBindLocatedBinders mbinds
 325         (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
 326     in
 327     checkDupNames meth_doc meth_names   `thenM_`
 328     extendTyVarEnvForMethodBinds inst_tyvars (
 329         -- (Slightly strangely) the forall-d tyvars scope over
 330         -- the method bindings too
 331         rnMethodBinds cls (\n->[])      -- No scoped tyvars
 332                       [] mbinds
 333     )                                           `thenM` \ (mbinds', meth_fvs) ->
 334         -- Rename the prags and signatures.
 335         -- Note that the type variables are not in scope here,
 336         -- so that      instance Eq a => Eq (T a) where
 337         --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
 338         -- works OK.
 339         --
 340         -- But the (unqualified) method names are in scope
 341     let
 342         binders = collectHsBindBinders mbinds'
 343         ok_sig  = okInstDclSig (mkNameSet binders)
 344     in
 345     bindLocalNames binders (renameSigs ok_sig uprags)   `thenM` \ uprags' ->
 346
 347     returnM (InstDecl inst_ty' mbinds' uprags' ats',
 348              meth_fvs `plusFV` at_fvs
 349                       `plusFV` hsSigsFVs uprags'
 350                       `plusFV` extractHsTyNames inst_ty')
 351              -- We return the renamed associated data type declarations so
 352              -- that they can be entered into the list of type declarations
 353              -- for the binding group, but we also keep a copy in the instance.
 354              -- The latter is needed for well-formedness checks in the type
 355              -- checker (eg, to ensure that all ATs of the instance actually
 356              -- receive a declaration).
 357              -- NB: Even the copies in the instance declaration carry copies of
 358              --     the instance context after renaming.  This is a bit
 359              --     strange, but should not matter (and it would be more work
 360              --     to remove the context).
 361 \end{code}
 362
 363 Renaming of the associated types in instances.
 364
 365 * We raise an error if we encounter a kind signature in an instance.
 366
 367 \begin{code}
 368 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
 369 rnATInsts atDecls =
 370   mapFvRn (wrapLocFstM rnATInst) atDecls
 371   where
 372     rnATInst tydecl@TyFunction {} =
 373       do
 374         addErr noKindSig
 375         rnTyClDecl tydecl
 376     rnATInst tydecl@TySynonym  {} = rnTyClDecl tydecl
 377     rnATInst tydecl@TyData     {} =
 378       do
 379         checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
 380         rnTyClDecl tydecl
 381     rnATInst _                    =
 382       panic "RnSource.rnATInsts: not a type declaration"
 383
 384 noKindSig = text "Instances cannot have kind signatures"
 385 \end{code}
 386
 387 For the method bindings in class and instance decls, we extend the
 388 type variable environment iff -fglasgow-exts
 389
 390 \begin{code}
 391 extendTyVarEnvForMethodBinds tyvars thing_inside
 392   = doptM Opt_GlasgowExts                       `thenM` \ opt_GlasgowExts ->
 393     if opt_GlasgowExts then
 394         extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
 395     else
 396         thing_inside
 397 \end{code}
 398
 399 %*********************************************************
 400 %*                                                      *
 401 \subsection{Stand-alone deriving declarations}
 402 %*                                                      *
 403 %*********************************************************
 404
 405 \begin{code}
 406 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
 407 rnSrcDerivDecl (DerivDecl ty n)
 408   = do ty' <- rnLHsType (text "a deriving decl") ty
 409        n'  <- lookupLocatedOccRn n
 410        let fvs = extractHsTyNames ty' `addOneFV` unLoc n'
 411        return (DerivDecl ty' n', fvs)
 412 \end{code}
 413
 414 %*********************************************************
 415 %*                                                      *
 416 \subsection{Rules}
 417 %*                                                      *
 418 %*********************************************************
 419
 420 \begin{code}
 421 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
 422   = bindPatSigTyVarsFV (collectRuleBndrSigTys vars)     $
 423
 424     bindLocatedLocalsFV doc (map get_var vars)          $ \ ids ->
 425     mapFvRn rn_var (vars `zip` ids)             `thenM` \ (vars', fv_vars) ->
 426
 427     rnLExpr lhs                                 `thenM` \ (lhs', fv_lhs') ->
 428     rnLExpr rhs                                 `thenM` \ (rhs', fv_rhs') ->
 429
 430     checkValidRule rule_name ids lhs' fv_lhs'   `thenM_`
 431
 432     returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
 433              fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
 434   where
 435     doc = text "In the transformation rule" <+> ftext rule_name
 436
 437     get_var (RuleBndr v)      = v
 438     get_var (RuleBndrSig v _) = v
 439
 440     rn_var (RuleBndr (L loc v), id)
 441         = returnM (RuleBndr (L loc id), emptyFVs)
 442     rn_var (RuleBndrSig (L loc v) t, id)
 443         = rnHsTypeFVs doc t     `thenM` \ (t', fvs) ->
 444           returnM (RuleBndrSig (L loc id) t', fvs)
 445
 446 badRuleVar name var
 447   = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
 448          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
 449                 ptext SLIT("does not appear on left hand side")]
 450 \end{code}
 451
 452 Note [Rule LHS validity checking]
 453 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 454 Check the shape of a transformation rule LHS.  Currently we only allow
 455 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
 456 @forall@'d variables.
 457
 458 We used restrict the form of the 'ei' to prevent you writing rules
 459 with LHSs with a complicated desugaring (and hence unlikely to match);
 460 (e.g. a case expression is not allowed: too elaborate.)
 461
 462 But there are legitimate non-trivial args ei, like sections and
 463 lambdas.  So it seems simmpler not to check at all, and that is why
 464 check_e is commented out.
 465
 466 \begin{code}
 467 checkValidRule rule_name ids lhs' fv_lhs'
 468   = do  {       -- Check for the form of the LHS
 469           case (validRuleLhs ids lhs') of
 470                 Nothing  -> return ()
 471                 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
 472
 473                 -- Check that LHS vars are all bound
 474         ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
 475         ; mappM (addErr . badRuleVar rule_name) bad_vars }
 476
 477 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
 478 -- Nothing => OK
 479 -- Just e  => Not ok, and e is the offending expression
 480 validRuleLhs foralls lhs
 481   = checkl lhs
 482   where
 483     checkl (L loc e) = check e
 484
 485     check (OpApp e1 op _ e2)              = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
 486     check (HsApp e1 e2)                   = checkl e1 `seqMaybe` checkl_e e2
 487     check (HsVar v) | v `notElem` foralls = Nothing
 488     check other                           = Just other  -- Failure
 489
 490         -- Check an argument
 491     checkl_e (L loc e) = Nothing        -- Was (check_e e); see Note [Rule LHS validity checking]
 492
 493 {-      Commented out; see Note [Rule LHS validity checking] above
 494     check_e (HsVar v)     = Nothing
 495     check_e (HsPar e)     = checkl_e e
 496     check_e (HsLit e)     = Nothing
 497     check_e (HsOverLit e) = Nothing
 498
 499     check_e (OpApp e1 op _ e2)   = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
 500     check_e (HsApp e1 e2)        = checkl_e e1 `seqMaybe` checkl_e e2
 501     check_e (NegApp e _)         = checkl_e e
 502     check_e (ExplicitList _ es)  = checkl_es es
 503     check_e (ExplicitTuple es _) = checkl_es es
 504     check_e other                = Just other   -- Fails
 505
 506     checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
 507 -}
 508
 509 badRuleLhsErr name lhs bad_e
 510   = sep [ptext SLIT("Rule") <+> ftext name <> colon,
 511          nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
 512                        ptext SLIT("in left-hand side:") <+> ppr lhs])]
 513     $$
 514     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
 515 \end{code}
 516
 517
 518 %*********************************************************
 519 %*                                                      *
 520 \subsection{Type, class and iface sig declarations}
 521 %*                                                      *
 522 %*********************************************************
 523
 524 @rnTyDecl@ uses the `global name function' to create a new type
 525 declaration in which local names have been replaced by their original
 526 names, reporting any unknown names.
 527
 528 Renaming type variables is a pain. Because they now contain uniques,
 529 it is necessary to pass in an association list which maps a parsed
 530 tyvar to its @Name@ representation.
 531 In some cases (type signatures of values),
 532 it is even necessary to go over the type first
 533 in order to get the set of tyvars used by it, make an assoc list,
 534 and then go over it again to rename the tyvars!
 535 However, we can also do some scoping checks at the same time.
 536
 537 \begin{code}
 538 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
 539   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
 540     returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
 541              emptyFVs)
 542
 543 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
 544                            tcdLName = tycon, tcdTyVars = tyvars,
 545                            tcdTyPats = typatsMaybe, tcdCons = condecls,
 546                            tcdKindSig = sig, tcdDerivs = derivs})
 547   | isKindSigDecl tydecl  -- kind signature of indexed type
 548   = rnTySig tydecl bindTyVarsRn
 549   | is_vanilla            -- Normal Haskell data type decl
 550   = ASSERT( isNothing sig )     -- In normal H98 form, kind signature on the
 551                                 -- data type is syntactically illegal
 552     bindTyVarsRn data_doc tyvars                $ \ tyvars' ->
 553     do  { tycon' <- if isIdxTyDecl tydecl
 554                     then lookupLocatedOccRn     tycon -- may be imported family
 555                     else lookupLocatedTopBndrRn tycon
 556         ; context' <- rnContext data_doc context
 557         ; typats' <- rnTyPats data_doc typatsMaybe
 558         ; (derivs', deriv_fvs) <- rn_derivs derivs
 559         ; checkDupNames data_doc con_names
 560         ; condecls' <- rnConDecls (unLoc tycon') condecls
 561         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
 562                            tcdLName = tycon', tcdTyVars = tyvars',
 563                            tcdTyPats = typats', tcdKindSig = Nothing,
 564                            tcdCons = condecls', tcdDerivs = derivs'},
 565                    delFVs (map hsLTyVarName tyvars')    $
 566                    extractHsCtxtTyNames context'        `plusFV`
 567                    plusFVs (map conDeclFVs condecls')   `plusFV`
 568                    deriv_fvs                            `plusFV`
 569                    (if isIdxTyDecl tydecl
 570                    then unitFV (unLoc tycon')   -- type instance => use
 571                    else emptyFVs))
 572         }
 573
 574   | otherwise             -- GADT
 575   = ASSERT( none typatsMaybe )    -- GADTs cannot have type patterns for now
 576     do  { tycon' <- if isIdxTyDecl tydecl
 577                     then lookupLocatedOccRn     tycon -- may be imported family
 578                     else lookupLocatedTopBndrRn tycon
 579         ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
 580         ; tyvars' <- bindTyVarsRn data_doc tyvars
 581                                   (\ tyvars' -> return tyvars')
 582                 -- For GADTs, the type variables in the declaration
 583                 -- do not scope over the constructor signatures
 584                 --      data T a where { T1 :: forall b. b-> b }
 585         ; (derivs', deriv_fvs) <- rn_derivs derivs
 586         ; checkDupNames data_doc con_names
 587         ; condecls' <- rnConDecls (unLoc tycon') condecls
 588         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
 589                            tcdLName = tycon', tcdTyVars = tyvars',
 590                            tcdTyPats = Nothing, tcdKindSig = sig,
 591                            tcdCons = condecls', tcdDerivs = derivs'},
 592                    plusFVs (map conDeclFVs condecls') `plusFV`
 593                    deriv_fvs                          `plusFV`
 594                    (if isIdxTyDecl tydecl
 595                    then unitFV (unLoc tycon')   -- type instance => use
 596                    else emptyFVs))
 597         }
 598   where
 599     is_vanilla = case condecls of       -- Yuk
 600                      []                    -> True
 601                      L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
 602                      other                 -> False
 603
 604     none Nothing   = True
 605     none (Just []) = True
 606     none _         = False
 607
 608     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 609     con_names = map con_names_helper condecls
 610
 611     con_names_helper (L _ c) = con_name c
 612
 613     rn_derivs Nothing   = returnM (Nothing, emptyFVs)
 614     rn_derivs (Just ds) = rnLHsTypes data_doc ds        `thenM` \ ds' ->
 615                           returnM (Just ds', extractHsTyNames_s ds')
 616
 617 rnTyClDecl (tydecl@TyFunction {}) =
 618   rnTySig tydecl bindTyVarsRn
 619
 620 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
 621                               tcdTyPats = typatsMaybe, tcdSynRhs = ty})
 622   = bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
 623     do { name' <- if isIdxTyDecl tydecl
 624                   then lookupLocatedOccRn     name -- may be imported family
 625                   else lookupLocatedTopBndrRn name
 626        ; typats' <- rnTyPats syn_doc typatsMaybe
 627        ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
 628        ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
 629                              tcdTyPats = typats', tcdSynRhs = ty'},
 630                   delFVs (map hsLTyVarName tyvars') $
 631                   fvs                         `plusFV`
 632                    (if isIdxTyDecl tydecl
 633                    then unitFV (unLoc name')    -- type instance => use
 634                    else emptyFVs))
 635        }
 636   where
 637     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 638
 639 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
 640                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 641                        tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
 642   = lookupLocatedTopBndrRn cname                `thenM` \ cname' ->
 643
 644         -- Tyvars scope over superclass context and method signatures
 645     bindTyVarsRn cls_doc tyvars                 ( \ tyvars' ->
 646         rnContext cls_doc context       `thenM` \ context' ->
 647         rnFds cls_doc fds               `thenM` \ fds' ->
 648         rnATs ats                       `thenM` \ (ats', ats_fvs) ->
 649         renameSigs okClsDclSig sigs     `thenM` \ sigs' ->
 650         mapM rnDocEntity docs           `thenM` \ docs' ->
 651         returnM   (tyvars', context', fds', (ats', ats_fvs), sigs', docs')
 652     )   `thenM` \ (tyvars', context', fds', (ats', ats_fvs), sigs', docs') ->
 653
 654         -- Check for duplicates among the associated types
 655     let
 656       at_rdr_names_w_locs      = [tcdLName ty | L _ ty <- ats]
 657     in
 658     checkDupNames at_doc at_rdr_names_w_locs   `thenM_`
 659
 660         -- Check the signatures
 661         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 662     let
 663         sig_rdr_names_w_locs   = [op | L _ (TypeSig op _) <- sigs]
 664     in
 665     checkDupNames sig_doc sig_rdr_names_w_locs  `thenM_`
 666         -- Typechecker is responsible for checking that we only
 667         -- give default-method bindings for things in this class.
 668         -- The renamer *could* check this for class decls, but can't
 669         -- for instance decls.
 670
 671         -- The newLocals call is tiresome: given a generic class decl
 672         --      class C a where
 673         --        op :: a -> a
 674         --        op {| x+y |} (Inl a) = ...
 675         --        op {| x+y |} (Inr b) = ...
 676         --        op {| a*b |} (a*b)   = ...
 677         -- we want to name both "x" tyvars with the same unique, so that they are
 678         -- easy to group together in the typechecker.
 679     extendTyVarEnvForMethodBinds tyvars' (
 680          getLocalRdrEnv                                 `thenM` \ name_env ->
 681          let
 682              meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
 683              gen_rdr_tyvars_w_locs =
 684                 [ tv | tv <- extractGenericPatTyVars mbinds,
 685                       not (unLoc tv `elemLocalRdrEnv` name_env) ]
 686          in
 687          checkDupNames meth_doc meth_rdr_names_w_locs   `thenM_`
 688          newLocalsRn gen_rdr_tyvars_w_locs      `thenM` \ gen_tyvars ->
 689          rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
 690     ) `thenM` \ (mbinds', meth_fvs) ->
 691
 692     returnM (ClassDecl { tcdCtxt = context', tcdLName = cname',
 693                          tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
 694                          tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
 695              delFVs (map hsLTyVarName tyvars')  $
 696              extractHsCtxtTyNames context'          `plusFV`
 697              plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
 698              hsSigsFVs sigs'                        `plusFV`
 699              meth_fvs                               `plusFV`
 700              ats_fvs)
 701   where
 702     meth_doc = text "In the default-methods for class"  <+> ppr cname
 703     cls_doc  = text "In the declaration for class"      <+> ppr cname
 704     sig_doc  = text "In the signatures for class"       <+> ppr cname
 705     at_doc   = text "In the associated types for class" <+> ppr cname
 706
 707 badGadtStupidTheta tycon
 708   = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
 709           ptext SLIT("(You can put a context on each contructor, though.)")]
 710 \end{code}
 711
 712 %*********************************************************
 713 %*                                                      *
 714 \subsection{Support code for type/data declarations}
 715 %*                                                      *
 716 %*********************************************************
 717
 718 \begin{code}
 719 -- Although, we are processing type patterns here, all type variables will
 720 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
 721 -- type declaration to which these patterns belong)
 722 --
 723 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
 724 rnTyPats _   Nothing       = return Nothing
 725 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
 726
 727 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
 728 rnConDecls tycon condecls
 729   = mappM (wrapLocM rnConDecl) condecls
 730
 731 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
 732 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
 733   = do  { addLocM checkConName name
 734
 735         ; new_name <- lookupLocatedTopBndrRn name
 736         ; name_env <- getLocalRdrEnv
 737
 738         -- For H98 syntax, the tvs are the existential ones
 739         -- For GADT syntax, the tvs are all the quantified tyvars
 740         -- Hence the 'filter' in the ResTyH98 case only
 741         ; let not_in_scope  = not . (`elemLocalRdrEnv` name_env) . unLoc
 742               arg_tys       = hsConArgs details
 743               implicit_tvs  = case res_ty of
 744                                 ResTyH98 -> filter not_in_scope $
 745                                                 get_rdr_tvs arg_tys
 746                                 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
 747               tvs' = case expl of
 748                         Explicit -> tvs
 749                         Implicit -> userHsTyVarBndrs implicit_tvs
 750
 751         ; mb_doc' <- rnMbLHsDoc mb_doc
 752
 753         ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
 754         { new_context <- rnContext doc cxt
 755         ; new_details <- rnConDetails doc details
 756         ; (new_details', new_res_ty)  <- rnConResult doc new_details res_ty
 757         ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
 758  where
 759     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 760     get_rdr_tvs tys  = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
 761
 762 rnConResult _ details ResTyH98 = return (details, ResTyH98)
 763
 764 rnConResult doc details (ResTyGADT ty) = do
 765     ty' <- rnHsSigType doc ty
 766     let (arg_tys, res_ty) = splitHsFunType ty'
 767         -- We can split it up, now the renamer has dealt with fixities
 768     case details of
 769         PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
 770         RecCon fields -> return (details, ResTyGADT ty')
 771         InfixCon {}   -> panic "rnConResult"
 772
 773 rnConDetails doc (PrefixCon tys)
 774   = mappM (rnLHsType doc) tys   `thenM` \ new_tys  ->
 775     returnM (PrefixCon new_tys)
 776
 777 rnConDetails doc (InfixCon ty1 ty2)
 778   = rnLHsType doc ty1           `thenM` \ new_ty1 ->
 779     rnLHsType doc ty2           `thenM` \ new_ty2 ->
 780     returnM (InfixCon new_ty1 new_ty2)
 781
 782 rnConDetails doc (RecCon fields)
 783   = checkDupNames doc field_names       `thenM_`
 784     mappM (rnField doc) fields          `thenM` \ new_fields ->
 785     returnM (RecCon new_fields)
 786   where
 787     field_names = [ name | HsRecField name _ _ <- fields ]
 788
 789 -- Document comments are renamed to Nothing here
 790 rnField doc (HsRecField name ty haddock_doc)
 791   = lookupLocatedTopBndrRn name `thenM` \ new_name ->
 792     rnLHsType doc ty            `thenM` \ new_ty ->
 793     rnMbLHsDoc haddock_doc      `thenM` \ new_haddock_doc ->
 794     returnM (HsRecField new_name new_ty new_haddock_doc)
 795
 796 -- Rename kind signatures (signatures of indexed data types/newtypes and
 797 -- signatures of type functions)
 798 --
 799 -- * This function is parametrised by the routine handling the index
 800 --   variables.  On the toplevel, these are defining occurences, whereas they
 801 --   are usage occurences for associated types.
 802 --
 803 rnTySig :: TyClDecl RdrName
 804         -> (SDoc -> [LHsTyVarBndr RdrName] ->
 805             ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
 806             RnM (TyClDecl Name, FreeVars))
 807         -> RnM (TyClDecl Name, FreeVars)
 808
 809 rnTySig (tydecl@TyData {tcdCtxt = context, tcdLName = tycon,
 810                         tcdTyVars = tyvars, tcdTyPats = mb_typats,
 811                         tcdCons = condecls, tcdKindSig = sig,
 812                         tcdDerivs = derivs})
 813         bindIdxVars =
 814       ASSERT( null condecls )       -- won't have constructors
 815       ASSERT( isNothing mb_typats ) -- won't have type patterns
 816       ASSERT( isNothing derivs )    -- won't have deriving
 817       ASSERT( isJust sig )          -- will have kind signature
 818       do { checkM (not . null $ tyvars) $ addErr needOneIdx   -- #indexes >= 1
 819          ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
 820          ; tycon' <- lookupLocatedTopBndrRn tycon
 821          ; context' <- rnContext (ksig_doc tycon) context
 822          ; returnM (TyData {tcdND = tcdND tydecl, tcdCtxt = context',
 823                             tcdLName = tycon', tcdTyVars = tyvars',
 824                             tcdTyPats = Nothing, tcdKindSig = sig,
 825                             tcdCons = [], tcdDerivs = Nothing},
 826                     delFVs (map hsLTyVarName tyvars') $
 827                     extractHsCtxtTyNames context')
 828          } }
 829       where
 830
 831 rnTySig (tydecl@TyFunction {tcdLName = tycon, tcdTyVars = tyvars,
 832                             tcdKind = sig})
 833         bindIdxVars =
 834       do { checkM (not . null $ tyvars) $ addErr needOneIdx   -- #indexes >= 1
 835          ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
 836          ; tycon' <- lookupLocatedTopBndrRn tycon
 837          ; returnM (TyFunction {tcdLName = tycon', tcdTyVars = tyvars',
 838                                 tcdIso = tcdIso tydecl, tcdKind = sig},
 839                     emptyFVs)
 840          } }
 841
 842 ksig_doc tycon = text "In the kind signature for" <+> quotes (ppr tycon)
 843 needOneIdx = text "Kind signature requires at least one type index"
 844
 845 -- Rename associated type declarations (in classes)
 846 --
 847 -- * This can be kind signatures and (default) type function equations.
 848 --
 849 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
 850 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
 851   where
 852     rn_at (tydecl@TyData     {}) = rnTySig tydecl lookupIdxVars
 853     rn_at (tydecl@TyFunction {}) = rnTySig tydecl lookupIdxVars
 854     rn_at (tydecl@TySynonym  {}) =
 855       do
 856         checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
 857         rnTyClDecl tydecl
 858     rn_at _                      = panic "RnSource.rnATs: invalid TyClDecl"
 859
 860     lookupIdxVars _ tyvars cont =
 861       do { checkForDups tyvars;
 862          ; tyvars' <- mappM lookupIdxVar tyvars
 863          ; cont tyvars'
 864          }
 865     -- Type index variables must be class parameters, which are the only
 866     -- type variables in scope at this point.
 867     lookupIdxVar (L l tyvar) =
 868       do
 869         name' <- lookupOccRn (hsTyVarName tyvar)
 870         return $ L l (replaceTyVarName tyvar name')
 871
 872     -- Type variable may only occur once.
 873     --
 874     checkForDups [] = return ()
 875     checkForDups (L loc tv:ltvs) =
 876       do { setSrcSpan loc $
 877              when (hsTyVarName tv `ltvElem` ltvs) $
 878                addErr (repeatedTyVar tv)
 879          ; checkForDups ltvs
 880          }
 881
 882     rdrName `ltvElem` [] = False
 883     rdrName `ltvElem` (L _ tv:ltvs)
 884       | rdrName == hsTyVarName tv = True
 885       | otherwise                 = rdrName `ltvElem` ltvs
 886
 887 noPatterns = text "Default definition for an associated synonym cannot have"
 888              <+> text "type pattern"
 889
 890 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
 891                    quotes (ppr tv)
 892
 893 -- This data decl will parse OK
 894 --      data T = a Int
 895 -- treating "a" as the constructor.
 896 -- It is really hard to make the parser spot this malformation.
 897 -- So the renamer has to check that the constructor is legal
 898 --
 899 -- We can get an operator as the constructor, even in the prefix form:
 900 --      data T = :% Int Int
 901 -- from interface files, which always print in prefix form
 902
 903 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
 904
 905 badDataCon name
 906    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 907 \end{code}
 908
 909
 910 %*********************************************************
 911 %*                                                      *
 912 \subsection{Support code to rename types}
 913 %*                                                      *
 914 %*********************************************************
 915
 916 \begin{code}
 917 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
 918
 919 rnFds doc fds
 920   = mappM (wrapLocM rn_fds) fds
 921   where
 922     rn_fds (tys1, tys2)
 923       = rnHsTyVars doc tys1             `thenM` \ tys1' ->
 924         rnHsTyVars doc tys2             `thenM` \ tys2' ->
 925         returnM (tys1', tys2')
 926
 927 rnHsTyVars doc tvs  = mappM (rnHsTyvar doc) tvs
 928 rnHsTyvar doc tyvar = lookupOccRn tyvar
 929 \end{code}
 930
 931
 932 %*********************************************************
 933 %*                                                      *
 934                 Splices
 935 %*                                                      *
 936 %*********************************************************
 937
 938 Note [Splices]
 939 ~~~~~~~~~~~~~~
 940 Consider
 941         f = ...
 942         h = ...$(thing "f")...
 943
 944 The splice can expand into literally anything, so when we do dependency
 945 analysis we must assume that it might mention 'f'.  So we simply treat
 946 all locally-defined names as mentioned by any splice.  This is terribly
 947 brutal, but I don't see what else to do.  For example, it'll mean
 948 that every locally-defined thing will appear to be used, so no unused-binding
 949 warnings.  But if we miss the dependency, then we might typecheck 'h' before 'f',
 950 and that will crash the type checker because 'f' isn't in scope.
 951
 952 Currently, I'm not treating a splice as also mentioning every import,
 953 which is a bit inconsistent -- but there are a lot of them.  We might
 954 thereby get some bogus unused-import warnings, but we won't crash the
 955 type checker.  Not very satisfactory really.
 956
 957 \begin{code}
 958 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
 959 rnSplice (HsSplice n expr)
 960   = do  { checkTH expr "splice"
 961         ; loc  <- getSrcSpanM
 962         ; [n'] <- newLocalsRn [L loc n]
 963         ; (expr', fvs) <- rnLExpr expr
 964
 965         -- Ugh!  See Note [Splices] above
 966         ; lcl_rdr <- getLocalRdrEnv
 967         ; gbl_rdr <- getGlobalRdrEnv
 968         ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
 969                                                     isLocalGRE gre]
 970               lcl_names = mkNameSet (occEnvElts lcl_rdr)
 971
 972         ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
 973
 974 #ifdef GHCI
 975 checkTH e what = returnM ()     -- OK
 976 #else
 977 checkTH e what  -- Raise an error in a stage-1 compiler
 978   = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
 979                   ptext SLIT("illegal in a stage-1 compiler"),
 980                   nest 2 (ppr e)])
 981 #endif
 982 \end{code}