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