ghc/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 ( rnTyClDecl, rnIfaceRuleDecl, rnInstDecl, rnSourceDecls,
   8                   rnHsType, rnHsSigType, rnHsTypeFVs, rnHsSigTypeFVs
   9         ) where
  10
  11 #include "HsVersions.h"
  12
  13 import RnExpr
  14 import HsSyn
  15 import HscTypes         ( GlobalRdrEnv )
  16 import HsTypes          ( hsTyVarNames, pprHsContext )
  17 import RdrName          ( RdrName, isRdrDataCon, rdrNameOcc, elemRdrEnv )
  18 import RdrHsSyn         ( RdrNameContext, RdrNameHsType, RdrNameConDecl, RdrNameTyClDecl,
  19                           extractRuleBndrsTyVars, extractHsTyRdrTyVars,
  20                           extractHsCtxtRdrTyVars, extractGenericPatTyVars
  21                         )
  22 import RnHsSyn
  23 import HsCore
  24
  25 import RnBinds          ( rnTopBinds, rnMethodBinds, renameSigs, renameSigsFVs )
  26 import RnEnv            ( lookupTopBndrRn, lookupOccRn, newIPName, lookupIfaceName,
  27                           lookupOrigNames, lookupSysBinder, newLocalsRn,
  28                           bindLocalsFVRn,
  29                           bindTyVarsRn, bindTyVars2Rn,
  30                           bindTyVarsFV2Rn, extendTyVarEnvFVRn,
  31                           bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
  32                           checkDupOrQualNames, checkDupNames, mapFvRn
  33                         )
  34 import RnMonad
  35
  36 import Class            ( FunDep, DefMeth (..) )
  37 import DataCon          ( dataConId )
  38 import Name             ( Name, OccName, nameOccName, NamedThing(..) )
  39 import NameSet
  40 import PrelInfo         ( derivableClassKeys, cCallishClassKeys )
  41 import PrelNames        ( deRefStablePtr_RDR, newStablePtr_RDR,
  42                           bindIO_RDR, returnIO_RDR
  43                         )
  44 import TysWiredIn       ( tupleCon )
  45 import List             ( partition, nub )
  46 import Outputable
  47 import SrcLoc           ( SrcLoc )
  48 import CmdLineOpts      ( DynFlag(..) )
  49                                 -- Warn of unused for-all'd tyvars
  50 import Unique           ( Uniquable(..) )
  51 import ErrUtils         ( Message )
  52 import CStrings         ( isCLabelString )
  53 import ListSetOps       ( removeDupsEq )
  54 \end{code}
  55
  56 @rnSourceDecl@ `renames' declarations.
  57 It simultaneously performs dependency analysis and precedence parsing.
  58 It also does the following error checks:
  59 \begin{enumerate}
  60 \item
  61 Checks that tyvars are used properly. This includes checking
  62 for undefined tyvars, and tyvars in contexts that are ambiguous.
  63 (Some of this checking has now been moved to module @TcMonoType@,
  64 since we don't have functional dependency information at this point.)
  65 \item
  66 Checks that all variable occurences are defined.
  67 \item
  68 Checks the @(..)@ etc constraints in the export list.
  69 \end{enumerate}
  70
  71
  72 %*********************************************************
  73 %*                                                      *
  74 \subsection{Value declarations}
  75 %*                                                      *
  76 %*********************************************************
  77
  78 \begin{code}
  79 rnSourceDecls :: GlobalRdrEnv -> LocalFixityEnv
  80               -> [RdrNameHsDecl]
  81               -> RnMG ([RenamedHsDecl], FreeVars)
  82         -- The decls get reversed, but that's ok
  83
  84 rnSourceDecls gbl_env local_fixity_env decls
  85   = initRnMS gbl_env local_fixity_env SourceMode (go emptyFVs [] decls)
  86   where
  87         -- Fixity and deprecations have been dealt with already; ignore them
  88     go fvs ds' []             = returnRn (ds', fvs)
  89     go fvs ds' (FixD _:ds)    = go fvs ds' ds
  90     go fvs ds' (DeprecD _:ds) = go fvs ds' ds
  91     go fvs ds' (d:ds)         = rnSourceDecl d  `thenRn` \(d', fvs') ->
  92                                 go (fvs `plusFV` fvs') (d':ds') ds
  93 \end{code}
  94
  95
  96 %*********************************************************
  97 %*                                                      *
  98 \subsection{Value declarations}
  99 %*                                                      *
 100 %*********************************************************
 101
 102 \begin{code}
 103 -- rnSourceDecl does all the work
 104 rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
 105
 106 rnSourceDecl (ValD binds) = rnTopBinds binds    `thenRn` \ (new_binds, fvs) ->
 107                             returnRn (ValD new_binds, fvs)
 108
 109 rnSourceDecl (TyClD tycl_decl)
 110   = rnTyClDecl tycl_decl                `thenRn` \ new_decl ->
 111     rnClassBinds tycl_decl new_decl     `thenRn` \ (new_decl', fvs) ->
 112     traceRn (text "rnClassDecl:" <+> (ppr (nameSetToList (tyClDeclFVs new_decl')) $$
 113                                       ppr (nameSetToList fvs)))         `thenRn_`
 114     returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
 115
 116 rnSourceDecl (InstD inst)
 117   = rnInstDecl inst             `thenRn` \ new_inst ->
 118     rnInstBinds inst new_inst   `thenRn` \ (new_inst', fvs) ->
 119     returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
 120
 121 rnSourceDecl (RuleD rule)
 122   = rnHsRuleDecl rule           `thenRn` \ (new_rule, fvs) ->
 123     returnRn (RuleD new_rule, fvs)
 124
 125 rnSourceDecl (DefD (DefaultDecl tys src_loc))
 126   = pushSrcLocRn src_loc $
 127     mapFvRn (rnHsTypeFVs doc_str) tys           `thenRn` \ (tys', fvs) ->
 128     returnRn (DefD (DefaultDecl tys' src_loc), fvs)
 129   where
 130     doc_str = text "a `default' declaration"
 131
 132 rnSourceDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
 133   = pushSrcLocRn src_loc $
 134     lookupOccRn name                    `thenRn` \ name' ->
 135     let
 136         extra_fvs FoExport
 137           | isDyn = lookupOrigNames [newStablePtr_RDR, deRefStablePtr_RDR,
 138                                      bindIO_RDR, returnIO_RDR]
 139           | otherwise =
 140                 lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs ->
 141                 returnRn (addOneFV fvs name')
 142         extra_fvs other = returnRn emptyFVs
 143     in
 144     checkRn (ok_ext_nm ext_nm) (badExtName ext_nm)      `thenRn_`
 145
 146     extra_fvs imp_exp                                   `thenRn` \ fvs1 ->
 147
 148     rnHsTypeFVs fo_decl_msg ty                  `thenRn` \ (ty', fvs2) ->
 149     returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
 150               fvs1 `plusFV` fvs2)
 151  where
 152   fo_decl_msg = ptext SLIT("The foreign declaration for") <+> ppr name
 153   isDyn       = isDynamicExtName ext_nm
 154
 155   ok_ext_nm Dynamic                = True
 156   ok_ext_nm (ExtName nm (Just mb)) = isCLabelString nm && isCLabelString mb
 157   ok_ext_nm (ExtName nm Nothing)   = isCLabelString nm
 158 \end{code}
 159
 160
 161 %*********************************************************
 162 %*                                                      *
 163 \subsection{Instance declarations}
 164 %*                                                      *
 165 %*********************************************************
 166
 167 \begin{code}
 168 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
 169   = pushSrcLocRn src_loc $
 170     rnHsSigType (text "an instance decl") inst_ty       `thenRn` \ inst_ty' ->
 171
 172     (case maybe_dfun_rdr_name of
 173         Nothing            -> returnRn Nothing
 174         Just dfun_rdr_name -> lookupIfaceName dfun_rdr_name     `thenRn` \ dfun_name ->
 175                               returnRn (Just dfun_name)
 176     )                                                   `thenRn` \ maybe_dfun_name ->
 177
 178     -- The typechecker checks that all the bindings are for the right class.
 179     returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
 180
 181 -- Compare rnClassBinds
 182 rnInstBinds (InstDecl _       mbinds uprags _                   _      )
 183             (InstDecl inst_ty _      _      maybe_dfun_rdr_name src_loc)
 184   = let
 185         meth_doc    = text "the bindings in an instance declaration"
 186         meth_names  = collectLocatedMonoBinders mbinds
 187         inst_tyvars = case inst_ty of
 188                         HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
 189                         other                             -> []
 190         -- (Slightly strangely) the forall-d tyvars scope over
 191         -- the method bindings too
 192     in
 193
 194         -- Rename the bindings
 195         -- NB meth_names can be qualified!
 196     checkDupNames meth_doc meth_names           `thenRn_`
 197     extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
 198         rnMethodBinds [] mbinds
 199     )                                           `thenRn` \ (mbinds', meth_fvs) ->
 200     let
 201         binders    = collectMonoBinders mbinds'
 202         binder_set = mkNameSet binders
 203     in
 204         -- Rename the prags and signatures.
 205         -- Note that the type variables are not in scope here,
 206         -- so that      instance Eq a => Eq (T a) where
 207         --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
 208         -- works OK.
 209         --
 210         -- But the (unqualified) method names are in scope
 211     bindLocalNames binders (
 212        renameSigsFVs (okInstDclSig binder_set) uprags
 213     )                                                   `thenRn` \ (uprags', prag_fvs) ->
 214
 215     returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_rdr_name src_loc,
 216               meth_fvs `plusFV` prag_fvs)
 217 \end{code}
 218
 219 %*********************************************************
 220 %*                                                      *
 221 \subsection{Rules}
 222 %*                                                      *
 223 %*********************************************************
 224
 225 \begin{code}
 226 rnIfaceRuleDecl (IfaceRule rule_name vars fn args rhs src_loc)
 227   = pushSrcLocRn src_loc        $
 228     lookupOccRn fn              `thenRn` \ fn' ->
 229     rnCoreBndrs vars            $ \ vars' ->
 230     mapRn rnCoreExpr args       `thenRn` \ args' ->
 231     rnCoreExpr rhs              `thenRn` \ rhs' ->
 232     returnRn (IfaceRule rule_name vars' fn' args' rhs' src_loc)
 233
 234 rnHsRuleDecl (HsRule rule_name tvs vars lhs rhs src_loc)
 235   = ASSERT( null tvs )
 236     pushSrcLocRn src_loc                        $
 237
 238     bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
 239     bindLocalsFVRn doc (map get_var vars)       $ \ ids ->
 240     mapFvRn rn_var (vars `zip` ids)             `thenRn` \ (vars', fv_vars) ->
 241
 242     rnExpr lhs                                  `thenRn` \ (lhs', fv_lhs) ->
 243     rnExpr rhs                                  `thenRn` \ (rhs', fv_rhs) ->
 244     checkRn (validRuleLhs ids lhs')
 245             (badRuleLhsErr rule_name lhs')      `thenRn_`
 246     let
 247         bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
 248     in
 249     mapRn (addErrRn . badRuleVar rule_name) bad_vars    `thenRn_`
 250     returnRn (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc,
 251               fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
 252   where
 253     doc = text "the transformation rule" <+> ptext rule_name
 254     sig_tvs = extractRuleBndrsTyVars vars
 255
 256     get_var (RuleBndr v)      = v
 257     get_var (RuleBndrSig v _) = v
 258
 259     rn_var (RuleBndr v, id)      = returnRn (RuleBndr id, emptyFVs)
 260     rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t    `thenRn` \ (t', fvs) ->
 261                                    returnRn (RuleBndrSig id t', fvs)
 262 \end{code}
 263
 264
 265 %*********************************************************
 266 %*                                                      *
 267 \subsection{Type, class and iface sig declarations}
 268 %*                                                      *
 269 %*********************************************************
 270
 271 @rnTyDecl@ uses the `global name function' to create a new type
 272 declaration in which local names have been replaced by their original
 273 names, reporting any unknown names.
 274
 275 Renaming type variables is a pain. Because they now contain uniques,
 276 it is necessary to pass in an association list which maps a parsed
 277 tyvar to its @Name@ representation.
 278 In some cases (type signatures of values),
 279 it is even necessary to go over the type first
 280 in order to get the set of tyvars used by it, make an assoc list,
 281 and then go over it again to rename the tyvars!
 282 However, we can also do some scoping checks at the same time.
 283
 284 \begin{code}
 285 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
 286   = pushSrcLocRn loc $
 287     lookupTopBndrRn name                `thenRn` \ name' ->
 288     rnHsType doc_str ty                 `thenRn` \ ty' ->
 289     mapRn rnIdInfo id_infos             `thenRn` \ id_infos' ->
 290     returnRn (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
 291   where
 292     doc_str = text "the interface signature for" <+> quotes (ppr name)
 293
 294 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
 295                     tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = nconstrs,
 296                     tcdDerivs = derivings, tcdLoc = src_loc, tcdSysNames = sys_names})
 297   = pushSrcLocRn src_loc $
 298     lookupTopBndrRn tycon                       `thenRn` \ tycon' ->
 299     bindTyVarsRn data_doc tyvars                $ \ tyvars' ->
 300     rnContext data_doc context                  `thenRn` \ context' ->
 301     checkDupOrQualNames data_doc con_names      `thenRn_`
 302     mapRn rnConDecl condecls                    `thenRn` \ condecls' ->
 303     mapRn lookupSysBinder sys_names             `thenRn` \ sys_names' ->
 304     rnDerivs derivings                          `thenRn` \ derivings' ->
 305     returnRn (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
 306                       tcdTyVars = tyvars', tcdCons = condecls', tcdNCons = nconstrs,
 307                       tcdDerivs = derivings', tcdLoc = src_loc, tcdSysNames = sys_names'})
 308   where
 309     data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
 310     con_names = map conDeclName condecls
 311
 312 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
 313   = pushSrcLocRn src_loc $
 314     doptRn Opt_GlasgowExts                      `thenRn` \ glaExts ->
 315     lookupTopBndrRn name                        `thenRn` \ name' ->
 316     bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
 317     rnHsType syn_doc (unquantify glaExts ty)    `thenRn` \ ty' ->
 318     returnRn (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
 319   where
 320     syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
 321
 322         -- For H98 we do *not* universally quantify on the RHS of a synonym
 323         -- Silently discard context... but the tyvars in the rest won't be in scope
 324         -- In interface files all types are quantified, so this is a no-op
 325     unquantify glaExts (HsForAllTy Nothing ctxt ty) | glaExts = ty
 326     unquantify glaExys ty                                     = ty
 327
 328 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
 329                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 330                        tcdSysNames = names, tcdLoc = src_loc})
 331   = pushSrcLocRn src_loc $
 332
 333     lookupTopBndrRn cname                       `thenRn` \ cname' ->
 334
 335         -- Deal with the implicit tycon and datacon name
 336         -- They aren't in scope (because they aren't visible to the user)
 337         -- and what we want to do is simply look them up in the cache;
 338         -- we jolly well ought to get a 'hit' there!
 339     mapRn lookupSysBinder names                 `thenRn` \ names' ->
 340
 341         -- Tyvars scope over bindings and context
 342     bindTyVars2Rn cls_doc tyvars                $ \ clas_tyvar_names tyvars' ->
 343
 344         -- Check the superclasses
 345     rnContext cls_doc context                   `thenRn` \ context' ->
 346
 347         -- Check the functional dependencies
 348     rnFds cls_doc fds                           `thenRn` \ fds' ->
 349
 350         -- Check the signatures
 351         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 352     let
 353         (op_sigs, non_op_sigs) = partition isClassOpSig sigs
 354         sig_rdr_names_w_locs   = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
 355     in
 356     checkDupOrQualNames sig_doc sig_rdr_names_w_locs            `thenRn_`
 357     mapRn (rnClassOp cname' clas_tyvar_names fds') op_sigs      `thenRn` \ sigs' ->
 358     let
 359         binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
 360     in
 361     renameSigs (okClsDclSig binders) non_op_sigs          `thenRn` \ non_ops' ->
 362
 363         -- Typechecker is responsible for checking that we only
 364         -- give default-method bindings for things in this class.
 365         -- The renamer *could* check this for class decls, but can't
 366         -- for instance decls.
 367
 368     returnRn (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
 369                           tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
 370                           tcdSysNames = names', tcdLoc = src_loc})
 371   where
 372     cls_doc  = text "the declaration for class"         <+> ppr cname
 373     sig_doc  = text "the signatures for class"          <+> ppr cname
 374
 375 rnClassOp clas clas_tyvars clas_fds sig@(ClassOpSig op dm_stuff ty locn)
 376   = pushSrcLocRn locn $
 377     lookupTopBndrRn op                  `thenRn` \ op_name ->
 378
 379         -- Check the signature
 380     rnHsSigType (quotes (ppr op)) ty    `thenRn` \ new_ty ->
 381
 382         -- Make the default-method name
 383     (case dm_stuff of
 384         DefMeth dm_rdr_name
 385             ->  -- Imported class that has a default method decl
 386                 -- See comments with tname, snames, above
 387                 lookupSysBinder dm_rdr_name     `thenRn` \ dm_name ->
 388                 returnRn (DefMeth dm_name)
 389                         -- An imported class decl for a class decl that had an explicit default
 390                         -- method, mentions, rather than defines,
 391                         -- the default method, so we must arrange to pull it in
 392
 393         GenDefMeth -> returnRn GenDefMeth
 394         NoDefMeth  -> returnRn NoDefMeth
 395     )                                           `thenRn` \ dm_stuff' ->
 396
 397     returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
 398
 399 rnClassBinds :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
 400 rnClassBinds (ClassDecl {tcdMeths = Nothing})
 401  rn_cls_decl@(ClassDecl {tcdSigs = sigs})
 402   -- No method bindings, so this class decl comes from an interface file,
 403   -- However we want to treat the default-method names as free (they should
 404   -- be defined somewhere else).  [In source code this is not so; the class
 405   -- decl will bind whatever default-methods are necessary.]
 406   = returnRn (rn_cls_decl, mkFVs [v | ClassOpSig _ (DefMeth v) _ _ <- sigs])
 407
 408 rnClassBinds (ClassDecl {tcdMeths = Just mbinds})               -- Get mbinds from here
 409  rn_cls_decl@(ClassDecl {tcdTyVars = tyvars, tcdLoc = src_loc}) -- Everything else is here
 410   -- There are some default-method bindings (abeit possibly empty) so
 411   -- this is a source-code class declaration
 412   =     -- The newLocals call is tiresome: given a generic class decl
 413         --      class C a where
 414         --        op :: a -> a
 415         --        op {| x+y |} (Inl a) = ...
 416         --        op {| x+y |} (Inr b) = ...
 417         --        op {| a*b |} (a*b)   = ...
 418         -- we want to name both "x" tyvars with the same unique, so that they are
 419         -- easy to group together in the typechecker.
 420         -- Hence the
 421     extendTyVarEnvFVRn (map hsTyVarName tyvars)         $
 422     getLocalNameEnv                                     `thenRn` \ name_env ->
 423     let
 424         meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
 425         gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
 426                                                 not (tv `elemRdrEnv` name_env)]
 427     in
 428     checkDupOrQualNames meth_doc meth_rdr_names_w_locs  `thenRn_`
 429     newLocalsRn gen_rdr_tyvars_w_locs                   `thenRn` \ gen_tyvars ->
 430     rnMethodBinds gen_tyvars mbinds                     `thenRn` \ (mbinds', meth_fvs) ->
 431     returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
 432   where
 433     meth_doc = text "the default-methods for class"     <+> ppr (tcdName rn_cls_decl)
 434
 435 rnClassBinds _ tycl_decl = returnRn (tycl_decl, emptyFVs)
 436         -- Not a class declaration
 437 \end{code}
 438
 439
 440 %*********************************************************
 441 %*                                                      *
 442 \subsection{Support code for type/data declarations}
 443 %*                                                      *
 444 %*********************************************************
 445
 446 \begin{code}
 447 rnDerivs :: Maybe [RdrName] -> RnMS (Maybe [Name])
 448
 449 rnDerivs Nothing -- derivs not specified
 450   = returnRn Nothing
 451
 452 rnDerivs (Just clss)
 453   = mapRn do_one clss   `thenRn` \ clss' ->
 454     returnRn (Just clss')
 455   where
 456     do_one cls = lookupOccRn cls        `thenRn` \ clas_name ->
 457                  checkRn (getUnique clas_name `elem` derivableClassKeys)
 458                          (derivingNonStdClassErr clas_name)     `thenRn_`
 459                  returnRn clas_name
 460 \end{code}
 461
 462 \begin{code}
 463 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
 464 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
 465
 466 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
 467 rnConDecl (ConDecl name wkr tvs cxt details locn)
 468   = pushSrcLocRn locn $
 469     checkConName name           `thenRn_`
 470     lookupTopBndrRn name        `thenRn` \ new_name ->
 471
 472     lookupSysBinder wkr         `thenRn` \ new_wkr ->
 473         -- See comments with ClassDecl
 474
 475     bindTyVarsRn doc tvs                $ \ new_tyvars ->
 476     rnContext doc cxt                   `thenRn` \ new_context ->
 477     rnConDetails doc locn details       `thenRn` \ new_details ->
 478     returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
 479   where
 480     doc = text "the definition of data constructor" <+> quotes (ppr name)
 481
 482 rnConDetails doc locn (VanillaCon tys)
 483   = mapRn (rnBangTy doc) tys    `thenRn` \ new_tys  ->
 484     returnRn (VanillaCon new_tys)
 485
 486 rnConDetails doc locn (InfixCon ty1 ty2)
 487   = rnBangTy doc ty1            `thenRn` \ new_ty1 ->
 488     rnBangTy doc ty2            `thenRn` \ new_ty2 ->
 489     returnRn (InfixCon new_ty1 new_ty2)
 490
 491 rnConDetails doc locn (RecCon fields)
 492   = checkDupOrQualNames doc field_names `thenRn_`
 493     mapRn (rnField doc) fields          `thenRn` \ new_fields ->
 494     returnRn (RecCon new_fields)
 495   where
 496     field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
 497
 498 rnField doc (names, ty)
 499   = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
 500     rnBangTy doc ty             `thenRn` \ new_ty ->
 501     returnRn (new_names, new_ty)
 502
 503 rnBangTy doc (Banged ty)
 504   = rnHsType doc ty             `thenRn` \ new_ty ->
 505     returnRn (Banged new_ty)
 506
 507 rnBangTy doc (Unbanged ty)
 508   = rnHsType doc ty             `thenRn` \ new_ty ->
 509     returnRn (Unbanged new_ty)
 510
 511 rnBangTy doc (Unpacked ty)
 512   = rnHsType doc ty             `thenRn` \ new_ty ->
 513     returnRn (Unpacked new_ty)
 514
 515 -- This data decl will parse OK
 516 --      data T = a Int
 517 -- treating "a" as the constructor.
 518 -- It is really hard to make the parser spot this malformation.
 519 -- So the renamer has to check that the constructor is legal
 520 --
 521 -- We can get an operator as the constructor, even in the prefix form:
 522 --      data T = :% Int Int
 523 -- from interface files, which always print in prefix form
 524
 525 checkConName name
 526   = checkRn (isRdrDataCon name)
 527             (badDataCon name)
 528 \end{code}
 529
 530
 531 %*********************************************************
 532 %*                                                      *
 533 \subsection{Support code to rename types}
 534 %*                                                      *
 535 %*********************************************************
 536
 537 \begin{code}
 538 rnHsTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
 539 rnHsTypeFVs doc_str ty
 540   = rnHsType doc_str ty         `thenRn` \ ty' ->
 541     returnRn (ty', extractHsTyNames ty')
 542
 543 rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
 544 rnHsSigTypeFVs doc_str ty
 545   = rnHsSigType doc_str ty      `thenRn` \ ty' ->
 546     returnRn (ty', extractHsTyNames ty')
 547
 548 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
 549         -- rnHsSigType is used for source-language type signatures,
 550         -- which use *implicit* universal quantification.
 551 rnHsSigType doc_str ty
 552   = rnHsType (text "the type signature for" <+> doc_str) ty
 553
 554 ---------------------------------------
 555 rnHsType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
 556
 557 rnHsType doc (HsForAllTy Nothing ctxt ty)
 558         -- Implicit quantifiction in source code (no kinds on tyvars)
 559         -- Given the signature  C => T  we universally quantify
 560         -- over FV(T) \ {in-scope-tyvars}
 561   = getLocalNameEnv             `thenRn` \ name_env ->
 562     let
 563         mentioned_in_tau  = extractHsTyRdrTyVars ty
 564         mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
 565         mentioned         = nub (mentioned_in_tau ++ mentioned_in_ctxt)
 566         forall_tyvars     = filter (not . (`elemRdrEnv` name_env)) mentioned
 567     in
 568     rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
 569
 570 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
 571         -- Explicit quantification.
 572         -- Check that the forall'd tyvars are actually
 573         -- mentioned in the type, and produce a warning if not
 574   = let
 575         mentioned_in_tau                = extractHsTyRdrTyVars tau
 576         mentioned_in_ctxt               = extractHsCtxtRdrTyVars ctxt
 577         mentioned                       = nub (mentioned_in_tau ++ mentioned_in_ctxt)
 578         forall_tyvar_names              = hsTyVarNames forall_tyvars
 579
 580         -- Explicitly quantified but not mentioned in ctxt or tau
 581         warn_guys                       = filter (`notElem` mentioned) forall_tyvar_names
 582     in
 583     mapRn_ (forAllWarn doc tau) warn_guys       `thenRn_`
 584     rnForAll doc forall_tyvars ctxt tau
 585
 586 rnHsType doc (HsTyVar tyvar)
 587   = lookupOccRn tyvar           `thenRn` \ tyvar' ->
 588     returnRn (HsTyVar tyvar')
 589
 590 rnHsType doc (HsOpTy ty1 opname ty2)
 591   = lookupOccRn opname  `thenRn` \ name' ->
 592     rnHsType doc ty1    `thenRn` \ ty1' ->
 593     rnHsType doc ty2    `thenRn` \ ty2' ->
 594     returnRn (HsOpTy ty1' name' ty2')
 595
 596 rnHsType doc (HsNumTy i)
 597   | i == 1    = returnRn (HsNumTy i)
 598   | otherwise = failWithRn (HsNumTy i)
 599                            (ptext SLIT("Only unit numeric type pattern is valid"))
 600
 601 rnHsType doc (HsFunTy ty1 ty2)
 602   = rnHsType doc ty1    `thenRn` \ ty1' ->
 603         -- Might find a for-all as the arg of a function type
 604     rnHsType doc ty2    `thenRn` \ ty2' ->
 605         -- Or as the result.  This happens when reading Prelude.hi
 606         -- when we find return :: forall m. Monad m -> forall a. a -> m a
 607     returnRn (HsFunTy ty1' ty2')
 608
 609 rnHsType doc (HsListTy ty)
 610   = rnHsType doc ty                             `thenRn` \ ty' ->
 611     returnRn (HsListTy ty')
 612
 613 -- Unboxed tuples are allowed to have poly-typed arguments.  These
 614 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
 615 rnHsType doc (HsTupleTy (HsTupCon _ boxity arity) tys)
 616         -- Don't do lookupOccRn, because this is built-in syntax
 617         -- so it doesn't need to be in scope
 618   = mapRn (rnHsType doc) tys            `thenRn` \ tys' ->
 619     returnRn (HsTupleTy (HsTupCon tup_name boxity arity) tys')
 620   where
 621     tup_name = tupleTyCon_name boxity arity
 622
 623
 624 rnHsType doc (HsAppTy ty1 ty2)
 625   = rnHsType doc ty1            `thenRn` \ ty1' ->
 626     rnHsType doc ty2            `thenRn` \ ty2' ->
 627     returnRn (HsAppTy ty1' ty2')
 628
 629 rnHsType doc (HsPredTy pred)
 630   = rnPred doc pred     `thenRn` \ pred' ->
 631     returnRn (HsPredTy pred')
 632
 633 rnHsTypes doc tys = mapRn (rnHsType doc) tys
 634 \end{code}
 635
 636 \begin{code}
 637 rnForAll doc forall_tyvars ctxt ty
 638   = bindTyVarsRn doc forall_tyvars      $ \ new_tyvars ->
 639     rnContext doc ctxt                  `thenRn` \ new_ctxt ->
 640     rnHsType doc ty                     `thenRn` \ new_ty ->
 641     returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty)
 642 \end{code}
 643
 644 \begin{code}
 645 rnContext :: SDoc -> RdrNameContext -> RnMS RenamedContext
 646 rnContext doc ctxt
 647   = mapRn rn_pred ctxt          `thenRn` \ theta ->
 648     let
 649         (_, dups) = removeDupsEq theta
 650                 -- We only have equality, not ordering
 651     in
 652         -- Check for duplicate assertions
 653         -- If this isn't an error, then it ought to be:
 654     mapRn (addWarnRn . dupClassAssertWarn theta) dups           `thenRn_`
 655     returnRn theta
 656   where
 657         --Someone discovered that @CCallable@ and @CReturnable@
 658         -- could be used in contexts such as:
 659         --      foo :: CCallable a => a -> PrimIO Int
 660         -- Doing this utterly wrecks the whole point of introducing these
 661         -- classes so we specifically check that this isn't being done.
 662     rn_pred pred = rnPred doc pred                              `thenRn` \ pred'->
 663                    checkRn (not (bad_pred pred'))
 664                            (naughtyCCallContextErr pred')       `thenRn_`
 665                    returnRn pred'
 666
 667     bad_pred (HsPClass clas _) = getUnique clas `elem` cCallishClassKeys
 668     bad_pred other             = False
 669
 670
 671 rnPred doc (HsPClass clas tys)
 672   = lookupOccRn clas            `thenRn` \ clas_name ->
 673     rnHsTypes doc tys           `thenRn` \ tys' ->
 674     returnRn (HsPClass clas_name tys')
 675
 676 rnPred doc (HsPIParam n ty)
 677   = newIPName n                 `thenRn` \ name ->
 678     rnHsType doc ty             `thenRn` \ ty' ->
 679     returnRn (HsPIParam name ty')
 680 \end{code}
 681
 682 \begin{code}
 683 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
 684
 685 rnFds doc fds
 686   = mapRn rn_fds fds
 687   where
 688     rn_fds (tys1, tys2)
 689       = rnHsTyVars doc tys1             `thenRn` \ tys1' ->
 690         rnHsTyVars doc tys2             `thenRn` \ tys2' ->
 691         returnRn (tys1', tys2')
 692
 693 rnHsTyVars doc tvs  = mapRn (rnHsTyvar doc) tvs
 694 rnHsTyvar doc tyvar = lookupOccRn tyvar
 695 \end{code}
 696
 697 %*********************************************************
 698 %*                                                       *
 699 \subsection{IdInfo}
 700 %*                                                       *
 701 %*********************************************************
 702
 703 \begin{code}
 704 rnIdInfo (HsWorker worker)
 705   = lookupOccRn worker                  `thenRn` \ worker' ->
 706     returnRn (HsWorker worker')
 707
 708 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
 709                                   returnRn (HsUnfold inline expr')
 710 rnIdInfo (HsStrictness str)     = returnRn (HsStrictness str)
 711 rnIdInfo (HsArity arity)        = returnRn (HsArity arity)
 712 rnIdInfo HsNoCafRefs            = returnRn HsNoCafRefs
 713 rnIdInfo HsCprInfo              = returnRn HsCprInfo
 714 \end{code}
 715
 716 @UfCore@ expressions.
 717
 718 \begin{code}
 719 rnCoreExpr (UfType ty)
 720   = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
 721     returnRn (UfType ty')
 722
 723 rnCoreExpr (UfVar v)
 724   = lookupOccRn v       `thenRn` \ v' ->
 725     returnRn (UfVar v')
 726
 727 rnCoreExpr (UfLit l)
 728   = returnRn (UfLit l)
 729
 730 rnCoreExpr (UfLitLit l ty)
 731   = rnHsType (text "litlit") ty `thenRn` \ ty' ->
 732     returnRn (UfLitLit l ty')
 733
 734 rnCoreExpr (UfCCall cc ty)
 735   = rnHsType (text "ccall") ty  `thenRn` \ ty' ->
 736     returnRn (UfCCall cc ty')
 737
 738 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
 739   = mapRn rnCoreExpr args               `thenRn` \ args' ->
 740     returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
 741   where
 742     tup_name = getName (dataConId (tupleCon boxity arity))
 743         -- Get the *worker* name and use that
 744
 745 rnCoreExpr (UfApp fun arg)
 746   = rnCoreExpr fun              `thenRn` \ fun' ->
 747     rnCoreExpr arg              `thenRn` \ arg' ->
 748     returnRn (UfApp fun' arg')
 749
 750 rnCoreExpr (UfCase scrut bndr alts)
 751   = rnCoreExpr scrut                    `thenRn` \ scrut' ->
 752     bindCoreLocalRn bndr                $ \ bndr' ->
 753     mapRn rnCoreAlt alts                `thenRn` \ alts' ->
 754     returnRn (UfCase scrut' bndr' alts')
 755
 756 rnCoreExpr (UfNote note expr)
 757   = rnNote note                 `thenRn` \ note' ->
 758     rnCoreExpr expr             `thenRn` \ expr' ->
 759     returnRn  (UfNote note' expr')
 760
 761 rnCoreExpr (UfLam bndr body)
 762   = rnCoreBndr bndr             $ \ bndr' ->
 763     rnCoreExpr body             `thenRn` \ body' ->
 764     returnRn (UfLam bndr' body')
 765
 766 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
 767   = rnCoreExpr rhs              `thenRn` \ rhs' ->
 768     rnCoreBndr bndr             $ \ bndr' ->
 769     rnCoreExpr body             `thenRn` \ body' ->
 770     returnRn (UfLet (UfNonRec bndr' rhs') body')
 771
 772 rnCoreExpr (UfLet (UfRec pairs) body)
 773   = rnCoreBndrs bndrs           $ \ bndrs' ->
 774     mapRn rnCoreExpr rhss       `thenRn` \ rhss' ->
 775     rnCoreExpr body             `thenRn` \ body' ->
 776     returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
 777   where
 778     (bndrs, rhss) = unzip pairs
 779 \end{code}
 780
 781 \begin{code}
 782 rnCoreBndr (UfValBinder name ty) thing_inside
 783   = rnHsType doc ty             `thenRn` \ ty' ->
 784     bindCoreLocalRn name        $ \ name' ->
 785     thing_inside (UfValBinder name' ty')
 786   where
 787     doc = text "unfolding id"
 788
 789 rnCoreBndr (UfTyBinder name kind) thing_inside
 790   = bindCoreLocalRn name                $ \ name' ->
 791     thing_inside (UfTyBinder name' kind)
 792
 793 rnCoreBndrs []     thing_inside = thing_inside []
 794 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b          $ \ name' ->
 795                                   rnCoreBndrs bs        $ \ names' ->
 796                                   thing_inside (name':names')
 797 \end{code}
 798
 799 \begin{code}
 800 rnCoreAlt (con, bndrs, rhs)
 801   = rnUfCon con                         `thenRn` \ con' ->
 802     bindCoreLocalsRn bndrs              $ \ bndrs' ->
 803     rnCoreExpr rhs                      `thenRn` \ rhs' ->
 804     returnRn (con', bndrs', rhs')
 805
 806 rnNote (UfCoerce ty)
 807   = rnHsType (text "unfolding coerce") ty       `thenRn` \ ty' ->
 808     returnRn (UfCoerce ty')
 809
 810 rnNote (UfSCC cc)   = returnRn (UfSCC cc)
 811 rnNote UfInlineCall = returnRn UfInlineCall
 812 rnNote UfInlineMe   = returnRn UfInlineMe
 813
 814
 815 rnUfCon UfDefault
 816   = returnRn UfDefault
 817
 818 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
 819   = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
 820   where
 821     tup_name = getName (tupleCon boxity arity)
 822
 823 rnUfCon (UfDataAlt con)
 824   = lookupOccRn con             `thenRn` \ con' ->
 825     returnRn (UfDataAlt con')
 826
 827 rnUfCon (UfLitAlt lit)
 828   = returnRn (UfLitAlt lit)
 829
 830 rnUfCon (UfLitLitAlt lit ty)
 831   = rnHsType (text "litlit") ty         `thenRn` \ ty' ->
 832     returnRn (UfLitLitAlt lit ty')
 833 \end{code}
 834
 835 %*********************************************************
 836 %*                                                       *
 837 \subsection{Rule shapes}
 838 %*                                                       *
 839 %*********************************************************
 840
 841 Check the shape of a transformation rule LHS.  Currently
 842 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
 843 not one of the @forall@'d variables.
 844
 845 \begin{code}
 846 validRuleLhs foralls lhs
 847   = check lhs
 848   where
 849     check (HsApp e1 e2)                   = check e1
 850     check (HsVar v) | v `notElem` foralls = True
 851     check other                           = False
 852 \end{code}
 853
 854
 855 %*********************************************************
 856 %*                                                       *
 857 \subsection{Errors}
 858 %*                                                       *
 859 %*********************************************************
 860
 861 \begin{code}
 862 derivingNonStdClassErr clas
 863   = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
 864
 865 badDataCon name
 866    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 867
 868 forAllWarn doc ty tyvar
 869   = doptRn Opt_WarnUnusedMatches `thenRn` \ warn_unused -> case () of
 870     () | not warn_unused -> returnRn ()
 871        | otherwise
 872        -> getModeRn             `thenRn` \ mode ->
 873           case mode of {
 874 #ifndef DEBUG
 875              InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
 876                                             -- unless DEBUG is on, in which case it is slightly
 877                                             -- informative.  They can arise from mkRhsTyLam,
 878 #endif                                      -- leading to (say)         f :: forall a b. [b] -> [b]
 879              other ->
 880                 addWarnRn (
 881                    sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
 882                    nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
 883                    $$
 884                    (ptext SLIT("In") <+> doc)
 885                 )
 886           }
 887
 888 badRuleLhsErr name lhs
 889   = sep [ptext SLIT("Rule") <+> ptext name <> colon,
 890          nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
 891     $$
 892     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
 893
 894 badRuleVar name var
 895   = sep [ptext SLIT("Rule") <+> ptext name <> colon,
 896          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
 897                 ptext SLIT("does not appear on left hand side")]
 898
 899 badExtName :: ExtName -> Message
 900 badExtName ext_nm
 901   = sep [quotes (ppr ext_nm) <+> ptext SLIT("is not a valid C identifier")]
 902
 903 dupClassAssertWarn ctxt (assertion : dups)
 904   = sep [hsep [ptext SLIT("Duplicate class assertion"),
 905                quotes (ppr assertion),
 906                ptext SLIT("in the context:")],
 907          nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
 908
 909 naughtyCCallContextErr (HsPClass clas _)
 910   = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
 911          ptext SLIT("in a context")]
 912 \end{code}