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