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, rnTyClDecls
   9     ) where
  10
  11 #include "HsVersions.h"
  12
  13 import {-# SOURCE #-} RnExpr( rnLExpr )
  14
  15 import HsSyn
  16 import RdrName          ( RdrName, isRdrDataCon, elemLocalRdrEnv, rdrNameOcc )
  17 import RdrHsSyn         ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
  18 import RnHsSyn
  19 import RnTypes          ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext, rnConDeclFields )
  20 import RnBinds          ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
  21                                 makeMiniFixityEnv)
  22 import RnEnv            ( lookupLocalDataTcNames, lookupLocatedOccRn,
  23                           lookupTopBndrRn, lookupLocatedTopBndrRn,
  24                           lookupOccRn, newLocalsRn,
  25                           bindLocatedLocalsFV, bindPatSigTyVarsFV,
  26                           bindTyVarsRn, extendTyVarEnvFVRn,
  27                           bindLocalNames, checkDupRdrNames, mapFvRn,
  28                           checkM
  29                         )
  30 import RnNames          ( getLocalNonValBinders, extendGlobalRdrEnvRn )
  31 import HscTypes         ( GenAvailInfo(..), availsToNameSet )
  32 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
  33 import TcRnMonad
  34
  35 import HscTypes         ( Warnings(..), plusWarns )
  36 import Class            ( FunDep )
  37 import Name             ( Name, nameOccName )
  38 import NameSet
  39 import NameEnv
  40 import Outputable
  41 import Bag
  42 import FastString
  43 import SrcLoc
  44 import DynFlags ( DynFlag(..) )
  45 import Maybe            ( isNothing )
  46 import BasicTypes       ( Boxity(..) )
  47
  48 import ListSetOps    (findDupsEq)
  49
  50 import Control.Monad
  51 \end{code}
  52
  53 \begin{code}
  54 -- XXX
  55 thenM :: Monad a => a b -> (b -> a c) -> a c
  56 thenM = (>>=)
  57
  58 thenM_ :: Monad a => a b -> a c -> a c
  59 thenM_ = (>>)
  60 \end{code}
  61
  62 @rnSourceDecl@ `renames' declarations.
  63 It simultaneously performs dependency analysis and precedence parsing.
  64 It also does the following error checks:
  65 \begin{enumerate}
  66 \item
  67 Checks that tyvars are used properly. This includes checking
  68 for undefined tyvars, and tyvars in contexts that are ambiguous.
  69 (Some of this checking has now been moved to module @TcMonoType@,
  70 since we don't have functional dependency information at this point.)
  71 \item
  72 Checks that all variable occurences are defined.
  73 \item
  74 Checks the @(..)@ etc constraints in the export list.
  75 \end{enumerate}
  76
  77
  78 \begin{code}
  79 -- Brings the binders of the group into scope in the appropriate places;
  80 -- does NOT assume that anything is in scope already
  81 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
  82 -- Rename a HsGroup; used for normal source files *and* hs-boot files
  83 rnSrcDecls group@(HsGroup {hs_valds  = val_decls,
  84                                    hs_tyclds = tycl_decls,
  85                                    hs_instds = inst_decls,
  86                                    hs_derivds = deriv_decls,
  87                                    hs_fixds  = fix_decls,
  88                                    hs_warnds  = warn_decls,
  89                                    hs_annds  = ann_decls,
  90                                    hs_fords  = foreign_decls,
  91                                    hs_defds  = default_decls,
  92                                    hs_ruleds = rule_decls,
  93                                    hs_docs   = docs })
  94  = do {
  95    -- (A) Process the fixity declarations, creating a mapping from
  96    --     FastStrings to FixItems.
  97    --     Also checks for duplcates.
  98    local_fix_env <- makeMiniFixityEnv fix_decls;
  99
 100    -- (B) Bring top level binders (and their fixities) into scope,
 101    --     *except* for the value bindings, which get brought in below.
 102    --     However *do* include class ops, data constructors
 103    --     And for hs-boot files *do* include the value signatures
 104    tc_avails <- getLocalNonValBinders group ;
 105    tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
 106    setEnvs tc_envs $ do {
 107
 108    failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
 109
 110    -- (C) Extract the mapping from data constructors to field names and
 111    --     extend the record field env.
 112    --     This depends on the data constructors and field names being in
 113    --     scope from (B) above
 114    inNewEnv (extendRecordFieldEnv tycl_decls inst_decls) $ \ _ -> do {
 115
 116    -- (D) Rename the left-hand sides of the value bindings.
 117    --     This depends on everything from (B) being in scope,
 118    --     and on (C) for resolving record wild cards.
 119    --     It uses the fixity env from (A) to bind fixities for view patterns.
 120    new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
 121    -- bind the LHSes (and their fixities) in the global rdr environment
 122    let { val_binders = map unLoc $ collectHsValBinders new_lhs ;
 123          val_bndr_set = mkNameSet val_binders ;
 124          all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
 125          val_avails = map Avail val_binders
 126        } ;
 127    (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
 128    setEnvs (tcg_env, tcl_env) $ do {
 129
 130    --  Now everything is in scope, as the remaining renaming assumes.
 131
 132    -- (E) Rename type and class decls
 133    --     (note that value LHSes need to be in scope for default methods)
 134    --
 135    -- You might think that we could build proper def/use information
 136    -- for type and class declarations, but they can be involved
 137    -- in mutual recursion across modules, and we only do the SCC
 138    -- analysis for them in the type checker.
 139    -- So we content ourselves with gathering uses only; that
 140    -- means we'll only report a declaration as unused if it isn't
 141    -- mentioned at all.  Ah well.
 142    traceRn (text "Start rnTyClDecls") ;
 143    (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
 144
 145    -- (F) Rename Value declarations right-hand sides
 146    traceRn (text "Start rnmono") ;
 147    (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
 148    traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
 149
 150    -- (G) Rename Fixity and deprecations
 151
 152    -- Rename fixity declarations and error if we try to
 153    -- fix something from another module (duplicates were checked in (A))
 154    rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
 155
 156    -- Rename deprec decls;
 157    -- check for duplicates and ensure that deprecated things are defined locally
 158    -- at the moment, we don't keep these around past renaming
 159    rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
 160
 161    -- (H) Rename Everything else
 162
 163    (rn_inst_decls,    src_fvs2) <- rnList rnSrcInstDecl   inst_decls ;
 164    (rn_rule_decls,    src_fvs3) <- setOptM Opt_ScopedTypeVariables $
 165                                    rnList rnHsRuleDecl    rule_decls ;
 166                            -- Inside RULES, scoped type variables are on
 167    (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
 168    (rn_ann_decls,     src_fvs5) <- rnList rnAnnDecl       ann_decls ;
 169    (rn_default_decls, src_fvs6) <- rnList rnDefaultDecl   default_decls ;
 170    (rn_deriv_decls,   src_fvs7) <- rnList rnSrcDerivDecl  deriv_decls ;
 171       -- Haddock docs; no free vars
 172    rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
 173
 174    -- (I) Compute the results and return
 175    let {rn_group = HsGroup { hs_valds  = rn_val_decls,
 176                              hs_tyclds = rn_tycl_decls,
 177                              hs_instds = rn_inst_decls,
 178                              hs_derivds = rn_deriv_decls,
 179                              hs_fixds  = rn_fix_decls,
 180                              hs_warnds = [], -- warns are returned in the tcg_env
 181                                              -- (see below) not in the HsGroup
 182                              hs_fords  = rn_foreign_decls,
 183                              hs_annds   = rn_ann_decls,
 184                              hs_defds  = rn_default_decls,
 185                              hs_ruleds = rn_rule_decls,
 186                              hs_docs   = rn_docs } ;
 187
 188         other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
 189                              src_fvs5, src_fvs6, src_fvs7] ;
 190         src_dus = bind_dus `plusDU` usesOnly other_fvs;
 191                 -- Note: src_dus will contain *uses* for locally-defined types
 192                 -- and classes, but no *defs* for them.  (Because rnTyClDecl
 193                 -- returns only the uses.)  This is a little
 194                 -- surprising but it doesn't actually matter at all.
 195
 196        final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
 197                        in -- we return the deprecs in the env, not in the HsGroup above
 198                          tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
 199        } ;
 200
 201    traceRn (text "finish rnSrc" <+> ppr rn_group) ;
 202    traceRn (text "finish Dus" <+> ppr src_dus ) ;
 203    return (final_tcg_env , rn_group)
 204                     }}}}
 205
 206 -- some utils because we do this a bunch above
 207 -- compute and install the new env
 208 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
 209 inNewEnv env cont = do e <- env
 210                        setGblEnv e $ cont e
 211
 212 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
 213 -- Used for external core
 214 rnTyClDecls tycl_decls = do  (decls', _fvs) <- rnList rnTyClDecl tycl_decls
 215                              return decls'
 216
 217 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
 218 -- This function could be defined lower down in the module hierarchy,
 219 -- but there doesn't seem anywhere very logical to put it.
 220 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
 221
 222 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
 223 rnList f xs = mapFvRn (wrapLocFstM f) xs
 224 \end{code}
 225
 226
 227 %*********************************************************
 228 %*                                                       *
 229         HsDoc stuff
 230 %*                                                       *
 231 %*********************************************************
 232
 233 \begin{code}
 234 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
 235 rnDocDecl (DocCommentNext doc) = do
 236   rn_doc <- rnHsDoc doc
 237   return (DocCommentNext rn_doc)
 238 rnDocDecl (DocCommentPrev doc) = do
 239   rn_doc <- rnHsDoc doc
 240   return (DocCommentPrev rn_doc)
 241 rnDocDecl (DocCommentNamed str doc) = do
 242   rn_doc <- rnHsDoc doc
 243   return (DocCommentNamed str rn_doc)
 244 rnDocDecl (DocGroup lev doc) = do
 245   rn_doc <- rnHsDoc doc
 246   return (DocGroup lev rn_doc)
 247 \end{code}
 248
 249
 250 %*********************************************************
 251 %*                                                       *
 252         Source-code fixity declarations
 253 %*                                                       *
 254 %*********************************************************
 255
 256 \begin{code}
 257 rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
 258 -- Rename the fixity decls, so we can put
 259 -- the renamed decls in the renamed syntax tree
 260 -- Errors if the thing being fixed is not defined locally.
 261 --
 262 -- The returned FixitySigs are not actually used for anything,
 263 -- except perhaps the GHCi API
 264 rnSrcFixityDecls bound_names fix_decls
 265   = do fix_decls <- mapM rn_decl fix_decls
 266        return (concat fix_decls)
 267   where
 268     rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
 269         -- GHC extension: look up both the tycon and data con
 270         -- for con-like things; hence returning a list
 271         -- If neither are in scope, report an error; otherwise
 272         -- return a fixity sig for each (slightly odd)
 273     rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
 274       = setSrcSpan name_loc $
 275                     -- this lookup will fail if the definition isn't local
 276         do names <- lookupLocalDataTcNames bound_names what rdr_name
 277            return [ L loc (FixitySig (L name_loc name) fixity)
 278                   | name <- names ]
 279     what = ptext (sLit "fixity signature")
 280 \end{code}
 281
 282
 283 %*********************************************************
 284 %*                                                       *
 285         Source-code deprecations declarations
 286 %*                                                       *
 287 %*********************************************************
 288
 289 Check that the deprecated names are defined, are defined locally, and
 290 that there are no duplicate deprecations.
 291
 292 It's only imported deprecations, dealt with in RnIfaces, that we
 293 gather them together.
 294
 295 \begin{code}
 296 -- checks that the deprecations are defined locally, and that there are no duplicates
 297 rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
 298 rnSrcWarnDecls _bound_names []
 299   = return NoWarnings
 300
 301 rnSrcWarnDecls bound_names decls
 302   = do { -- check for duplicates
 303        ; mapM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups
 304        ; mapM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
 305          return (WarnSome ((concat pairs_s))) }
 306  where
 307    rn_deprec (Warning rdr_name txt)
 308        -- ensures that the names are defined locally
 309      = lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
 310        return [(nameOccName name, txt) | name <- names]
 311
 312    what = ptext (sLit "deprecation")
 313
 314    -- look for duplicates among the OccNames;
 315    -- we check that the names are defined above
 316    -- invt: the lists returned by findDupsEq always have at least two elements
 317    warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
 318                      (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
 319
 320 dupWarnDecl :: Located RdrName -> RdrName -> SDoc
 321 -- Located RdrName -> DeprecDecl RdrName -> SDoc
 322 dupWarnDecl (L loc _) rdr_name
 323   = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
 324           ptext (sLit "also at ") <+> ppr loc]
 325
 326 \end{code}
 327
 328 %*********************************************************
 329 %*                                                      *
 330 \subsection{Annotation declarations}
 331 %*                                                      *
 332 %*********************************************************
 333
 334 \begin{code}
 335 rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
 336 rnAnnDecl (HsAnnotation provenance expr) = do
 337     (provenance', provenance_fvs) <- rnAnnProvenance provenance
 338     (expr', expr_fvs) <- rnLExpr expr
 339     return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs)
 340
 341 rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
 342 rnAnnProvenance provenance = do
 343     provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
 344     return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
 345 \end{code}
 346
 347 %*********************************************************
 348 %*                                                      *
 349 \subsection{Default declarations}
 350 %*                                                      *
 351 %*********************************************************
 352
 353 \begin{code}
 354 rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
 355 rnDefaultDecl (DefaultDecl tys)
 356   = mapFvRn (rnHsTypeFVs doc_str) tys   `thenM` \ (tys', fvs) ->
 357     return (DefaultDecl tys', fvs)
 358   where
 359     doc_str = text "In a `default' declaration"
 360 \end{code}
 361
 362 %*********************************************************
 363 %*                                                      *
 364 \subsection{Foreign declarations}
 365 %*                                                      *
 366 %*********************************************************
 367
 368 \begin{code}
 369 rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
 370 rnHsForeignDecl (ForeignImport name ty spec)
 371   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
 372     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
 373     return (ForeignImport name' ty' spec, fvs)
 374
 375 rnHsForeignDecl (ForeignExport name ty spec)
 376   = lookupLocatedOccRn name             `thenM` \ name' ->
 377     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
 378     return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
 379         -- NB: a foreign export is an *occurrence site* for name, so
 380         --     we add it to the free-variable list.  It might, for example,
 381         --     be imported from another module
 382
 383 fo_decl_msg :: Located RdrName -> SDoc
 384 fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
 385 \end{code}
 386
 387
 388 %*********************************************************
 389 %*                                                      *
 390 \subsection{Instance declarations}
 391 %*                                                      *
 392 %*********************************************************
 393
 394 \begin{code}
 395 rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
 396 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
 397         -- Used for both source and interface file decls
 398   = rnHsSigType (text "an instance decl") inst_ty       `thenM` \ inst_ty' ->
 399
 400         -- Rename the bindings
 401         -- The typechecker (not the renamer) checks that all
 402         -- the bindings are for the right class
 403     let
 404         meth_doc    = text "In the bindings in an instance declaration"
 405         meth_names  = collectHsBindLocatedBinders mbinds
 406         (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
 407     in
 408     checkDupRdrNames meth_doc meth_names        `thenM_`
 409         -- Check that the same method is not given twice in the
 410         -- same instance decl   instance C T where
 411         --                            f x = ...
 412         --                            g y = ...
 413         --                            f x = ...
 414         -- We must use checkDupRdrNames because the Name of the
 415         -- method is the Name of the class selector, whose SrcSpan
 416         -- points to the class declaration
 417
 418     extendTyVarEnvForMethodBinds inst_tyvars (
 419         -- (Slightly strangely) the forall-d tyvars scope over
 420         -- the method bindings too
 421         rnMethodBinds cls (\_ -> [])    -- No scoped tyvars
 422                       [] mbinds
 423     )                                           `thenM` \ (mbinds', meth_fvs) ->
 424         -- Rename the associated types
 425         -- The typechecker (not the renamer) checks that all
 426         -- the declarations are for the right class
 427     let
 428         at_doc   = text "In the associated types of an instance declaration"
 429         at_names = map (head . tyClDeclNames . unLoc) ats
 430     in
 431     checkDupRdrNames at_doc at_names            `thenM_`
 432         -- See notes with checkDupRdrNames for methods, above
 433
 434     rnATInsts ats                               `thenM` \ (ats', at_fvs) ->
 435
 436         -- Rename the prags and signatures.
 437         -- Note that the type variables are not in scope here,
 438         -- so that      instance Eq a => Eq (T a) where
 439         --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
 440         -- works OK.
 441         --
 442         -- But the (unqualified) method names are in scope
 443     let
 444         binders = collectHsBindBinders mbinds'
 445         bndr_set = mkNameSet binders
 446     in
 447     bindLocalNames binders
 448         (renameSigs (Just bndr_set) okInstDclSig uprags)        `thenM` \ uprags' ->
 449
 450     return (InstDecl inst_ty' mbinds' uprags' ats',
 451              meth_fvs `plusFV` at_fvs
 452                       `plusFV` hsSigsFVs uprags'
 453                       `plusFV` extractHsTyNames inst_ty')
 454              -- We return the renamed associated data type declarations so
 455              -- that they can be entered into the list of type declarations
 456              -- for the binding group, but we also keep a copy in the instance.
 457              -- The latter is needed for well-formedness checks in the type
 458              -- checker (eg, to ensure that all ATs of the instance actually
 459              -- receive a declaration).
 460              -- NB: Even the copies in the instance declaration carry copies of
 461              --     the instance context after renaming.  This is a bit
 462              --     strange, but should not matter (and it would be more work
 463              --     to remove the context).
 464 \end{code}
 465
 466 Renaming of the associated types in instances.
 467
 468 \begin{code}
 469 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
 470 rnATInsts atDecls = rnList rnATInst atDecls
 471   where
 472     rnATInst tydecl@TyData     {} = rnTyClDecl tydecl
 473     rnATInst tydecl@TySynonym  {} = rnTyClDecl tydecl
 474     rnATInst tydecl               =
 475       pprPanic "RnSource.rnATInsts: invalid AT instance"
 476                (ppr (tcdName tydecl))
 477 \end{code}
 478
 479 For the method bindings in class and instance decls, we extend the
 480 type variable environment iff -fglasgow-exts
 481
 482 \begin{code}
 483 extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
 484                              -> RnM (Bag (LHsBind Name), FreeVars)
 485                              -> RnM (Bag (LHsBind Name), FreeVars)
 486 extendTyVarEnvForMethodBinds tyvars thing_inside
 487   = do  { scoped_tvs <- doptM Opt_ScopedTypeVariables
 488         ; if scoped_tvs then
 489                 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
 490           else
 491                 thing_inside }
 492 \end{code}
 493
 494 %*********************************************************
 495 %*                                                      *
 496 \subsection{Stand-alone deriving declarations}
 497 %*                                                      *
 498 %*********************************************************
 499
 500 \begin{code}
 501 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
 502 rnSrcDerivDecl (DerivDecl ty)
 503   = do ty' <- rnLHsType (text "a deriving decl") ty
 504        let fvs = extractHsTyNames ty'
 505        return (DerivDecl ty', fvs)
 506 \end{code}
 507
 508 %*********************************************************
 509 %*                                                      *
 510 \subsection{Rules}
 511 %*                                                      *
 512 %*********************************************************
 513
 514 \begin{code}
 515 rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
 516 rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
 517   = bindPatSigTyVarsFV (collectRuleBndrSigTys vars)     $
 518     bindLocatedLocalsFV doc (map get_var vars)          $ \ ids ->
 519     do  { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
 520                 -- NB: The binders in a rule are always Ids
 521                 --     We don't (yet) support type variables
 522
 523         ; (lhs', fv_lhs') <- rnLExpr lhs
 524         ; (rhs', fv_rhs') <- rnLExpr rhs
 525
 526         ; checkValidRule rule_name ids lhs' fv_lhs'
 527
 528         ; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
 529                   fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
 530   where
 531     doc = text "In the transformation rule" <+> ftext rule_name
 532
 533     get_var (RuleBndr v)      = v
 534     get_var (RuleBndrSig v _) = v
 535
 536     rn_var (RuleBndr (L loc _), id)
 537         = return (RuleBndr (L loc id), emptyFVs)
 538     rn_var (RuleBndrSig (L loc _) t, id)
 539         = rnHsTypeFVs doc t     `thenM` \ (t', fvs) ->
 540           return (RuleBndrSig (L loc id) t', fvs)
 541
 542 badRuleVar :: FastString -> Name -> SDoc
 543 badRuleVar name var
 544   = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
 545          ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
 546                 ptext (sLit "does not appear on left hand side")]
 547 \end{code}
 548
 549 Note [Rule LHS validity checking]
 550 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 551 Check the shape of a transformation rule LHS.  Currently we only allow
 552 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
 553 @forall@'d variables.
 554
 555 We used restrict the form of the 'ei' to prevent you writing rules
 556 with LHSs with a complicated desugaring (and hence unlikely to match);
 557 (e.g. a case expression is not allowed: too elaborate.)
 558
 559 But there are legitimate non-trivial args ei, like sections and
 560 lambdas.  So it seems simmpler not to check at all, and that is why
 561 check_e is commented out.
 562
 563 \begin{code}
 564 checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
 565 checkValidRule rule_name ids lhs' fv_lhs'
 566   = do  {       -- Check for the form of the LHS
 567           case (validRuleLhs ids lhs') of
 568                 Nothing  -> return ()
 569                 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
 570
 571                 -- Check that LHS vars are all bound
 572         ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
 573         ; mapM_ (addErr . badRuleVar rule_name) bad_vars }
 574
 575 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
 576 -- Nothing => OK
 577 -- Just e  => Not ok, and e is the offending expression
 578 validRuleLhs foralls lhs
 579   = checkl lhs
 580   where
 581     checkl (L _ e) = check e
 582
 583     check (OpApp e1 op _ e2)              = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
 584     check (HsApp e1 e2)                   = checkl e1 `mplus` checkl_e e2
 585     check (HsVar v) | v `notElem` foralls = Nothing
 586     check other                           = Just other  -- Failure
 587
 588         -- Check an argument
 589     checkl_e (L _ _e) = Nothing         -- Was (check_e e); see Note [Rule LHS validity checking]
 590
 591 {-      Commented out; see Note [Rule LHS validity checking] above
 592     check_e (HsVar v)     = Nothing
 593     check_e (HsPar e)     = checkl_e e
 594     check_e (HsLit e)     = Nothing
 595     check_e (HsOverLit e) = Nothing
 596
 597     check_e (OpApp e1 op _ e2)   = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
 598     check_e (HsApp e1 e2)        = checkl_e e1 `mplus` checkl_e e2
 599     check_e (NegApp e _)         = checkl_e e
 600     check_e (ExplicitList _ es)  = checkl_es es
 601     check_e (ExplicitTuple es _) = checkl_es es
 602     check_e other                = Just other   -- Fails
 603
 604     checkl_es es = foldr (mplus . checkl_e) Nothing es
 605 -}
 606
 607 badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
 608 badRuleLhsErr name lhs bad_e
 609   = sep [ptext (sLit "Rule") <+> ftext name <> colon,
 610          nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
 611                        ptext (sLit "in left-hand side:") <+> ppr lhs])]
 612     $$
 613     ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
 614 \end{code}
 615
 616
 617 %*********************************************************
 618 %*                                                      *
 619 \subsection{Type, class and iface sig declarations}
 620 %*                                                      *
 621 %*********************************************************
 622
 623 @rnTyDecl@ uses the `global name function' to create a new type
 624 declaration in which local names have been replaced by their original
 625 names, reporting any unknown names.
 626
 627 Renaming type variables is a pain. Because they now contain uniques,
 628 it is necessary to pass in an association list which maps a parsed
 629 tyvar to its @Name@ representation.
 630 In some cases (type signatures of values),
 631 it is even necessary to go over the type first
 632 in order to get the set of tyvars used by it, make an assoc list,
 633 and then go over it again to rename the tyvars!
 634 However, we can also do some scoping checks at the same time.
 635
 636 \begin{code}
 637 rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
 638 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
 639   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
 640     return (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
 641              emptyFVs)
 642
 643 -- all flavours of type family declarations ("type family", "newtype fanily",
 644 -- and "data family")
 645 rnTyClDecl (tydecl@TyFamily {}) =
 646   rnFamily tydecl bindTyVarsRn
 647
 648 -- "data", "newtype", "data instance, and "newtype instance" declarations
 649 rnTyClDecl tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
 650                            tcdLName = tycon, tcdTyVars = tyvars,
 651                            tcdTyPats = typatsMaybe, tcdCons = condecls,
 652                            tcdKindSig = sig, tcdDerivs = derivs}
 653   | is_vanilla            -- Normal Haskell data type decl
 654   = ASSERT( isNothing sig )     -- In normal H98 form, kind signature on the
 655                                 -- data type is syntactically illegal
 656     ASSERT( distinctTyVarBndrs tyvars )   -- Tyvars should be distinct
 657     do  { bindTyVarsRn data_doc tyvars                  $ \ tyvars' -> do
 658         { tycon' <- if isFamInstDecl tydecl
 659                     then lookupLocatedOccRn     tycon -- may be imported family
 660                     else lookupLocatedTopBndrRn tycon
 661         ; context' <- rnContext data_doc context
 662         ; typats' <- rnTyPats data_doc typatsMaybe
 663         ; condecls' <- rnConDecls (unLoc tycon') condecls
 664                 -- No need to check for duplicate constructor decls
 665                 -- since that is done by RnNames.extendGlobalRdrEnvRn
 666         ; (derivs', deriv_fvs) <- rn_derivs derivs
 667         ; return (TyData {tcdND = new_or_data, tcdCtxt = context',
 668                            tcdLName = tycon', tcdTyVars = tyvars',
 669                            tcdTyPats = typats', tcdKindSig = Nothing,
 670                            tcdCons = condecls', tcdDerivs = derivs'},
 671                    delFVs (map hsLTyVarName tyvars')    $
 672                    extractHsCtxtTyNames context'        `plusFV`
 673                    plusFVs (map conDeclFVs condecls')   `plusFV`
 674                    deriv_fvs                            `plusFV`
 675                    (if isFamInstDecl tydecl
 676                    then unitFV (unLoc tycon')   -- type instance => use
 677                    else emptyFVs))
 678         } }
 679
 680   | otherwise             -- GADT
 681   = do  { tycon' <- if isFamInstDecl tydecl
 682                     then lookupLocatedOccRn     tycon -- may be imported family
 683                     else lookupLocatedTopBndrRn tycon
 684         ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
 685         ; (tyvars', typats')
 686                 <- bindTyVarsRn data_doc tyvars $ \ tyvars' -> do
 687                    { typats' <- rnTyPats data_doc typatsMaybe
 688                    ; return (tyvars', typats') }
 689                 -- For GADTs, the type variables in the declaration
 690                 -- do not scope over the constructor signatures
 691                 --      data T a where { T1 :: forall b. b-> b }
 692
 693         ; condecls' <- rnConDecls (unLoc tycon') condecls
 694                 -- No need to check for duplicate constructor decls
 695                 -- since that is done by RnNames.extendGlobalRdrEnvRn
 696
 697         ; (derivs', deriv_fvs) <- rn_derivs derivs
 698         ; return (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
 699                            tcdLName = tycon', tcdTyVars = tyvars',
 700                            tcdTyPats = typats', tcdKindSig = sig,
 701                            tcdCons = condecls', tcdDerivs = derivs'},
 702                    plusFVs (map conDeclFVs condecls') `plusFV`
 703                    deriv_fvs                          `plusFV`
 704                    (if isFamInstDecl tydecl
 705                    then unitFV (unLoc tycon')   -- type instance => use
 706                    else emptyFVs))
 707         }
 708   where
 709     is_vanilla = case condecls of       -- Yuk
 710                      []                    -> True
 711                      L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
 712                      _                     -> False
 713
 714     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 715
 716     rn_derivs Nothing   = return (Nothing, emptyFVs)
 717     rn_derivs (Just ds) = rnLHsTypes data_doc ds        `thenM` \ ds' ->
 718                           return (Just ds', extractHsTyNames_s ds')
 719
 720 -- "type" and "type instance" declarations
 721 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
 722                               tcdTyPats = typatsMaybe, tcdSynRhs = ty})
 723   = ASSERT( distinctTyVarBndrs tyvars )   -- Tyvars should be distinct
 724     do { bindTyVarsRn syn_doc tyvars                    $ \ tyvars' -> do
 725        { name' <- if isFamInstDecl tydecl
 726                   then lookupLocatedOccRn     name -- may be imported family
 727                   else lookupLocatedTopBndrRn name
 728        ; typats' <- rnTyPats syn_doc typatsMaybe
 729        ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
 730        ; return (TySynonym {tcdLName = name', tcdTyVars = tyvars',
 731                              tcdTyPats = typats', tcdSynRhs = ty'},
 732                   delFVs (map hsLTyVarName tyvars') $
 733                   fvs                         `plusFV`
 734                    (if isFamInstDecl tydecl
 735                    then unitFV (unLoc name')    -- type instance => use
 736                    else emptyFVs))
 737        } }
 738   where
 739     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 740
 741 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
 742                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 743                        tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
 744   = do  { cname' <- lookupLocatedTopBndrRn cname
 745
 746         -- Tyvars scope over superclass context and method signatures
 747         ; (tyvars', context', fds', ats', ats_fvs, sigs')
 748             <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
 749              { context' <- rnContext cls_doc context
 750              ; fds' <- rnFds cls_doc fds
 751              ; (ats', ats_fvs) <- rnATs ats
 752              ; sigs' <- renameSigs Nothing okClsDclSig sigs
 753              ; return   (tyvars', context', fds', ats', ats_fvs, sigs') }
 754
 755         -- No need to check for duplicate associated type decls
 756         -- since that is done by RnNames.extendGlobalRdrEnvRn
 757
 758         -- Check the signatures
 759         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 760         ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
 761         ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
 762                 -- Typechecker is responsible for checking that we only
 763                 -- give default-method bindings for things in this class.
 764                 -- The renamer *could* check this for class decls, but can't
 765                 -- for instance decls.
 766
 767         -- The newLocals call is tiresome: given a generic class decl
 768         --      class C a where
 769         --        op :: a -> a
 770         --        op {| x+y |} (Inl a) = ...
 771         --        op {| x+y |} (Inr b) = ...
 772         --        op {| a*b |} (a*b)   = ...
 773         -- we want to name both "x" tyvars with the same unique, so that they are
 774         -- easy to group together in the typechecker.
 775         ; (mbinds', meth_fvs)
 776             <- extendTyVarEnvForMethodBinds tyvars' $ do
 777             { name_env <- getLocalRdrEnv
 778             ; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
 779                                                  not (unLoc tv `elemLocalRdrEnv` name_env) ]
 780                 -- No need to check for duplicate method signatures
 781                 -- since that is done by RnNames.extendGlobalRdrEnvRn
 782                 -- and the methods are already in scope
 783             ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
 784             ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
 785
 786   -- Haddock docs
 787         ; docs' <- mapM (wrapLocM rnDocDecl) docs
 788
 789         ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
 790                               tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
 791                               tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
 792
 793                   delFVs (map hsLTyVarName tyvars')     $
 794                   extractHsCtxtTyNames context'         `plusFV`
 795                   plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
 796                   hsSigsFVs sigs'                       `plusFV`
 797                   meth_fvs                              `plusFV`
 798                   ats_fvs) }
 799   where
 800     cls_doc  = text "In the declaration for class"      <+> ppr cname
 801     sig_doc  = text "In the signatures for class"       <+> ppr cname
 802
 803 distinctTyVarBndrs :: [LHsTyVarBndr RdrName] -> Bool
 804 -- The tyvar binders should have distinct names
 805 distinctTyVarBndrs tvs
 806   = null (findDupsEq eq tvs)
 807   where
 808     eq (L _ v1) (L _ v2) = hsTyVarName v1 == hsTyVarName v2
 809
 810 badGadtStupidTheta :: Located RdrName -> SDoc
 811 badGadtStupidTheta _
 812   = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
 813           ptext (sLit "(You can put a context on each contructor, though.)")]
 814 \end{code}
 815
 816
 817 %*********************************************************
 818 %*                                                      *
 819 \subsection{Support code for type/data declarations}
 820 %*                                                      *
 821 %*********************************************************
 822
 823 \begin{code}
 824 -- Although, we are processing type patterns here, all type variables will
 825 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
 826 -- type declaration to which these patterns belong)
 827 --
 828 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
 829 rnTyPats _   Nothing       = return Nothing
 830 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
 831
 832 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
 833 rnConDecls _tycon condecls
 834   = mapM (wrapLocM rnConDecl) condecls
 835
 836 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
 837 rnConDecl decl@(ConDecl { con_name = name, con_qvars = tvs
 838                         , con_cxt = cxt, con_details = details
 839                         , con_res = res_ty, con_doc = mb_doc
 840                         , con_old_rec = old_rec, con_explicit = expl })
 841   = do  { addLocM checkConName name
 842         ; when old_rec (addWarn (deprecRecSyntax decl))
 843
 844         ; new_name <- lookupLocatedTopBndrRn name
 845         ; name_env <- getLocalRdrEnv
 846
 847         -- For H98 syntax, the tvs are the existential ones
 848         -- For GADT syntax, the tvs are all the quantified tyvars
 849         -- Hence the 'filter' in the ResTyH98 case only
 850         ; let not_in_scope  = not . (`elemLocalRdrEnv` name_env) . unLoc
 851               arg_tys       = hsConDeclArgTys details
 852               implicit_tvs  = case res_ty of
 853                                 ResTyH98     -> filter not_in_scope $
 854                                                 get_rdr_tvs arg_tys
 855                                 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
 856               new_tvs = case expl of
 857                           Explicit -> tvs
 858                           Implicit -> userHsTyVarBndrs implicit_tvs
 859
 860         ; mb_doc' <- rnMbLHsDoc mb_doc
 861
 862         ; bindTyVarsRn doc new_tvs $ \new_tyvars -> do
 863         { new_context <- rnContext doc cxt
 864         ; new_details <- rnConDeclDetails doc details
 865         ; (new_details', new_res_ty)  <- rnConResult doc new_details res_ty
 866         ; return (decl { con_name = new_name, con_qvars = new_tyvars, con_cxt = new_context
 867                        , con_details = new_details', con_res = new_res_ty, con_doc = mb_doc' }) }}
 868  where
 869     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 870     get_rdr_tvs tys  = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
 871
 872 rnConResult :: SDoc
 873             -> HsConDetails (LHsType Name) [ConDeclField Name]
 874             -> ResType RdrName
 875             -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
 876                     ResType Name)
 877 rnConResult _ details ResTyH98 = return (details, ResTyH98)
 878 rnConResult doc details (ResTyGADT ty)
 879   = do { ty' <- rnLHsType doc ty
 880        ; let (arg_tys, res_ty) = splitHsFunType ty'
 881                 -- We can finally split it up,
 882                 -- now the renamer has dealt with fixities
 883                 -- See Note [Sorting out the result type] in RdrHsSyn
 884
 885              details' = case details of
 886                            RecCon {}    -> details
 887                            PrefixCon {} -> PrefixCon arg_tys
 888                            InfixCon {}  -> pprPanic "rnConResult" (ppr ty)
 889                           -- See Note [Sorting out the result type] in RdrHsSyn
 890
 891        ; when (not (null arg_tys) && case details of { RecCon {} -> True; _ -> False })
 892               (addErr (badRecResTy doc))
 893        ; return (details', ResTyGADT res_ty) }
 894
 895 rnConDeclDetails :: SDoc
 896                  -> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
 897                  -> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
 898 rnConDeclDetails doc (PrefixCon tys)
 899   = mapM (rnLHsType doc) tys    `thenM` \ new_tys  ->
 900     return (PrefixCon new_tys)
 901
 902 rnConDeclDetails doc (InfixCon ty1 ty2)
 903   = rnLHsType doc ty1           `thenM` \ new_ty1 ->
 904     rnLHsType doc ty2           `thenM` \ new_ty2 ->
 905     return (InfixCon new_ty1 new_ty2)
 906
 907 rnConDeclDetails doc (RecCon fields)
 908   = do  { new_fields <- rnConDeclFields doc fields
 909                 -- No need to check for duplicate fields
 910                 -- since that is done by RnNames.extendGlobalRdrEnvRn
 911         ; return (RecCon new_fields) }
 912
 913 -- Rename family declarations
 914 --
 915 -- * This function is parametrised by the routine handling the index
 916 --   variables.  On the toplevel, these are defining occurences, whereas they
 917 --   are usage occurences for associated types.
 918 --
 919 rnFamily :: TyClDecl RdrName
 920          -> (SDoc -> [LHsTyVarBndr RdrName] ->
 921              ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
 922              RnM (TyClDecl Name, FreeVars))
 923          -> RnM (TyClDecl Name, FreeVars)
 924
 925 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
 926                            tcdLName = tycon, tcdTyVars = tyvars})
 927         bindIdxVars =
 928       do { bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
 929          ; tycon' <- lookupLocatedTopBndrRn tycon
 930          ; return (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
 931                               tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
 932                     emptyFVs)
 933          } }
 934 rnFamily d _ = pprPanic "rnFamily" (ppr d)
 935
 936 family_doc :: Located RdrName -> SDoc
 937 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
 938
 939 -- Rename associated type declarations (in classes)
 940 --
 941 -- * This can be family declarations and (default) type instances
 942 --
 943 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
 944 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
 945   where
 946     rn_at (tydecl@TyFamily  {}) = rnFamily tydecl lookupIdxVars
 947     rn_at (tydecl@TySynonym {}) =
 948       do
 949         checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
 950         rnTyClDecl tydecl
 951     rn_at _                      = panic "RnSource.rnATs: invalid TyClDecl"
 952
 953     lookupIdxVars _ tyvars cont =
 954       do { checkForDups tyvars;
 955          ; tyvars' <- mapM lookupIdxVar tyvars
 956          ; cont tyvars'
 957          }
 958     -- Type index variables must be class parameters, which are the only
 959     -- type variables in scope at this point.
 960     lookupIdxVar (L l tyvar) =
 961       do
 962         name' <- lookupOccRn (hsTyVarName tyvar)
 963         return $ L l (replaceTyVarName tyvar name')
 964
 965     -- Type variable may only occur once.
 966     --
 967     checkForDups [] = return ()
 968     checkForDups (L loc tv:ltvs) =
 969       do { setSrcSpan loc $
 970              when (hsTyVarName tv `ltvElem` ltvs) $
 971                addErr (repeatedTyVar tv)
 972          ; checkForDups ltvs
 973          }
 974
 975     _       `ltvElem` [] = False
 976     rdrName `ltvElem` (L _ tv:ltvs)
 977       | rdrName == hsTyVarName tv = True
 978       | otherwise                 = rdrName `ltvElem` ltvs
 979
 980 deprecRecSyntax :: ConDecl RdrName -> SDoc
 981 deprecRecSyntax decl
 982   = vcat [ ptext (sLit "Declaration of") <+> quotes (ppr (con_name decl))
 983                  <+> ptext (sLit "uses deprecated syntax")
 984          , ptext (sLit "Instead, use the form")
 985          , nest 2 (ppr decl) ]   -- Pretty printer uses new form
 986
 987 badRecResTy :: SDoc -> SDoc
 988 badRecResTy doc = ptext (sLit "Malformed constructor signature") $$ doc
 989
 990 noPatterns :: SDoc
 991 noPatterns = text "Default definition for an associated synonym cannot have"
 992              <+> text "type pattern"
 993
 994 repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
 995 repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
 996                    quotes (ppr tv)
 997
 998 -- This data decl will parse OK
 999 --      data T = a Int
1000 -- treating "a" as the constructor.
1001 -- It is really hard to make the parser spot this malformation.
1002 -- So the renamer has to check that the constructor is legal
1003 --
1004 -- We can get an operator as the constructor, even in the prefix form:
1005 --      data T = :% Int Int
1006 -- from interface files, which always print in prefix form
1007
1008 checkConName :: RdrName -> TcRn ()
1009 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1010
1011 badDataCon :: RdrName -> SDoc
1012 badDataCon name
1013    = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1014 \end{code}
1015
1016
1017 %*********************************************************
1018 %*                                                      *
1019 \subsection{Support code for type/data declarations}
1020 %*                                                      *
1021 %*********************************************************
1022
1023 Get the mapping from constructors to fields for this module.
1024 It's convenient to do this after the data type decls have been renamed
1025 \begin{code}
1026 extendRecordFieldEnv :: [LTyClDecl RdrName] -> [LInstDecl RdrName] -> TcM TcGblEnv
1027 extendRecordFieldEnv tycl_decls inst_decls
1028   = do  { tcg_env <- getGblEnv
1029         ; field_env' <- foldrM get_con (tcg_field_env tcg_env) all_data_cons
1030         ; return (tcg_env { tcg_field_env = field_env' }) }
1031   where
1032     -- we want to lookup:
1033     --  (a) a datatype constructor
1034     --  (b) a record field
1035     -- knowing that they're from this module.
1036     -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1037     -- which keeps only the local ones.
1038     lookup x = do { x' <- lookupLocatedTopBndrRn x
1039                     ; return $ unLoc x'}
1040
1041     all_data_cons :: [ConDecl RdrName]
1042     all_data_cons = [con | L _ (TyData { tcdCons = cons }) <- all_tycl_decls
1043                          , L _ con <- cons ]
1044     all_tycl_decls = at_tycl_decls ++ tycl_decls
1045     at_tycl_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
1046                       -- Do not forget associated types!
1047
1048     get_con (ConDecl { con_name = con, con_details = RecCon flds })
1049             (RecFields env fld_set)
1050         = do { con' <- lookup con
1051              ; flds' <- mapM lookup (map cd_fld_name flds)
1052              ; let env'    = extendNameEnv env con' flds'
1053                    fld_set' = addListToNameSet fld_set flds'
1054              ; return $ (RecFields env' fld_set') }
1055     get_con _ env = return env
1056 \end{code}
1057
1058 %*********************************************************
1059 %*                                                      *
1060 \subsection{Support code to rename types}
1061 %*                                                      *
1062 %*********************************************************
1063
1064 \begin{code}
1065 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1066
1067 rnFds doc fds
1068   = mapM (wrapLocM rn_fds) fds
1069   where
1070     rn_fds (tys1, tys2)
1071       = rnHsTyVars doc tys1             `thenM` \ tys1' ->
1072         rnHsTyVars doc tys2             `thenM` \ tys2' ->
1073         return (tys1', tys2')
1074
1075 rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1076 rnHsTyVars doc tvs  = mapM (rnHsTyVar doc) tvs
1077
1078 rnHsTyVar :: SDoc -> RdrName -> RnM Name
1079 rnHsTyVar _doc tyvar = lookupOccRn tyvar
1080 \end{code}
1081
1082