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