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         ) where
   9
  10 #include "HsVersions.h"
  11
  12 import RnExpr
  13 import HsSyn
  14 import HscTypes         ( GlobalRdrEnv, AvailEnv )
  15 import RdrName          ( RdrName, isRdrDataCon, elemRdrEnv )
  16 import RdrHsSyn         ( RdrNameConDecl, RdrNameTyClDecl,
  17                           extractGenericPatTyVars
  18                         )
  19 import RnHsSyn
  20 import HsCore
  21
  22 import RnTypes          ( rnHsType, rnHsSigType, rnHsTypeFVs, rnContext )
  23
  24 import RnBinds          ( rnTopBinds, rnMethodBinds, renameSigs, renameSigsFVs )
  25 import RnEnv            ( lookupTopBndrRn, lookupOccRn, lookupIfaceName,
  26                           lookupOrigNames, lookupSysBinder, newLocalsRn,
  27                           bindLocalsFVRn, bindPatSigTyVars,
  28                           bindTyVarsRn, bindTyVars2Rn,
  29                           extendTyVarEnvFVRn,
  30                           bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
  31                           checkDupOrQualNames, checkDupNames, mapFvRn
  32                         )
  33 import RnMonad
  34
  35 import Class            ( FunDep, DefMeth (..) )
  36 import DataCon          ( dataConId )
  37 import Name             ( Name, NamedThing(..) )
  38 import NameSet
  39 import PrelInfo         ( derivableClassKeys )
  40 import PrelNames        ( deRefStablePtrName, newStablePtrName,
  41                           bindIOName, returnIOName
  42                         )
  43 import TysWiredIn       ( tupleCon )
  44 import List             ( partition )
  45 import Outputable
  46 import SrcLoc           ( SrcLoc )
  47 import CmdLineOpts      ( DynFlag(..) )
  48                                 -- Warn of unused for-all'd tyvars
  49 import Unique           ( Uniquable(..) )
  50 import Maybes           ( maybeToBool )
  51 \end{code}
  52
  53 @rnSourceDecl@ `renames' declarations.
  54 It simultaneously performs dependency analysis and precedence parsing.
  55 It also does the following error checks:
  56 \begin{enumerate}
  57 \item
  58 Checks that tyvars are used properly. This includes checking
  59 for undefined tyvars, and tyvars in contexts that are ambiguous.
  60 (Some of this checking has now been moved to module @TcMonoType@,
  61 since we don't have functional dependency information at this point.)
  62 \item
  63 Checks that all variable occurences are defined.
  64 \item
  65 Checks the @(..)@ etc constraints in the export list.
  66 \end{enumerate}
  67
  68
  69 %*********************************************************
  70 %*                                                      *
  71 \subsection{Source code declarations}
  72 %*                                                      *
  73 %*********************************************************
  74
  75 \begin{code}
  76 rnSourceDecls :: GlobalRdrEnv -> AvailEnv -> LocalFixityEnv
  77               -> [RdrNameHsDecl]
  78               -> RnMG ([RenamedHsDecl], FreeVars)
  79         -- The decls get reversed, but that's ok
  80
  81 rnSourceDecls gbl_env avails local_fixity_env decls
  82   = initRnMS gbl_env avails emptyRdrEnv local_fixity_env SourceMode (go emptyFVs [] decls)
  83   where
  84         -- Fixity and deprecations have been dealt with already; ignore them
  85     go fvs ds' []             = returnRn (ds', fvs)
  86     go fvs ds' (FixD _:ds)    = go fvs ds' ds
  87     go fvs ds' (DeprecD _:ds) = go fvs ds' ds
  88     go fvs ds' (d:ds)         = rnSourceDecl d  `thenRn` \(d', fvs') ->
  89                                 go (fvs `plusFV` fvs') (d':ds') ds
  90
  91
  92 rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
  93
  94 rnSourceDecl (ValD binds) = rnTopBinds binds    `thenRn` \ (new_binds, fvs) ->
  95                             returnRn (ValD new_binds, fvs)
  96
  97 rnSourceDecl (TyClD tycl_decl)
  98   = rnTyClDecl tycl_decl                        `thenRn` \ new_decl ->
  99     finishSourceTyClDecl tycl_decl new_decl     `thenRn` \ (new_decl', fvs) ->
 100     returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
 101
 102 rnSourceDecl (InstD inst)
 103   = rnInstDecl inst                     `thenRn` \ new_inst ->
 104     finishSourceInstDecl inst new_inst  `thenRn` \ (new_inst', fvs) ->
 105     returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
 106
 107 rnSourceDecl (RuleD rule)
 108   = rnHsRuleDecl rule           `thenRn` \ (new_rule, fvs) ->
 109     returnRn (RuleD new_rule, fvs)
 110
 111 rnSourceDecl (ForD ford)
 112   = rnHsForeignDecl ford                `thenRn` \ (new_ford, fvs) ->
 113     returnRn (ForD new_ford, fvs)
 114
 115 rnSourceDecl (DefD (DefaultDecl tys src_loc))
 116   = pushSrcLocRn src_loc $
 117     mapFvRn (rnHsTypeFVs doc_str) tys           `thenRn` \ (tys', fvs) ->
 118     returnRn (DefD (DefaultDecl tys' src_loc), fvs)
 119   where
 120     doc_str = text "In a `default' declaration"
 121 \end{code}
 122
 123
 124 %*********************************************************
 125 %*                                                      *
 126 \subsection{Foreign declarations}
 127 %*                                                      *
 128 %*********************************************************
 129
 130 \begin{code}
 131 rnHsForeignDecl (ForeignImport name ty spec src_loc)
 132   = pushSrcLocRn src_loc                $
 133     lookupTopBndrRn name                `thenRn` \ name' ->
 134     rnHsTypeFVs (fo_decl_msg name) ty   `thenRn` \ (ty', fvs) ->
 135     returnRn (ForeignImport name' ty' spec src_loc, fvs `plusFV` extras spec)
 136   where
 137     extras (CDynImport _) = mkFVs [newStablePtrName, deRefStablePtrName, bindIOName, returnIOName]
 138     extras other          = emptyFVs
 139
 140 rnHsForeignDecl (ForeignExport name ty spec src_loc)
 141   = pushSrcLocRn src_loc                        $
 142     lookupOccRn name                            `thenRn` \ name' ->
 143     rnHsTypeFVs (fo_decl_msg name) ty           `thenRn` \ (ty', fvs) ->
 144     returnRn (ForeignExport name' ty' spec src_loc,
 145               mkFVs [bindIOName, returnIOName] `plusFV` fvs)
 146
 147 fo_decl_msg name = ptext SLIT("The foreign declaration for") <+> ppr name
 148 \end{code}
 149
 150
 151 %*********************************************************
 152 %*                                                      *
 153 \subsection{Instance declarations}
 154 %*                                                      *
 155 %*********************************************************
 156
 157 \begin{code}
 158 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
 159         -- Used for both source and interface file decls
 160   = pushSrcLocRn src_loc $
 161     rnHsSigType (text "an instance decl") inst_ty       `thenRn` \ inst_ty' ->
 162
 163     (case maybe_dfun_rdr_name of
 164         Nothing            -> returnRn Nothing
 165         Just dfun_rdr_name -> lookupIfaceName dfun_rdr_name     `thenRn` \ dfun_name ->
 166                               returnRn (Just dfun_name)
 167     )                                                   `thenRn` \ maybe_dfun_name ->
 168
 169     -- The typechecker checks that all the bindings are for the right class.
 170     returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
 171
 172 -- Compare finishSourceTyClDecl
 173 finishSourceInstDecl (InstDecl _       mbinds uprags _               _      )
 174                      (InstDecl inst_ty _      _      maybe_dfun_name src_loc)
 175         -- Used for both source decls only
 176   = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
 177     let
 178         meth_doc    = text "In the bindings in an instance declaration"
 179         meth_names  = collectLocatedMonoBinders mbinds
 180         (inst_tyvars, (cls,_)) = getHsInstHead inst_ty
 181         -- (Slightly strangely) the forall-d tyvars scope over
 182         -- the method bindings too
 183     in
 184
 185         -- Rename the bindings
 186         -- NB meth_names can be qualified!
 187     checkDupNames meth_doc meth_names           `thenRn_`
 188     extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
 189         rnMethodBinds cls [] mbinds
 190     )                                           `thenRn` \ (mbinds', meth_fvs) ->
 191     let
 192         binders    = collectMonoBinders mbinds'
 193         binder_set = mkNameSet binders
 194     in
 195         -- Rename the prags and signatures.
 196         -- Note that the type variables are not in scope here,
 197         -- so that      instance Eq a => Eq (T a) where
 198         --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
 199         -- works OK.
 200         --
 201         -- But the (unqualified) method names are in scope
 202     bindLocalNames binders (
 203        renameSigsFVs (okInstDclSig binder_set) uprags
 204     )                                                   `thenRn` \ (uprags', prag_fvs) ->
 205
 206     returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
 207               meth_fvs `plusFV` prag_fvs)
 208 \end{code}
 209
 210 %*********************************************************
 211 %*                                                      *
 212 \subsection{Rules}
 213 %*                                                      *
 214 %*********************************************************
 215
 216 \begin{code}
 217 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
 218   = pushSrcLocRn src_loc        $
 219     lookupOccRn fn              `thenRn` \ fn' ->
 220     rnCoreBndrs vars            $ \ vars' ->
 221     mapRn rnCoreExpr args       `thenRn` \ args' ->
 222     rnCoreExpr rhs              `thenRn` \ rhs' ->
 223     returnRn (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
 224
 225 rnIfaceRuleDecl (IfaceRuleOut fn rule)          -- Builtin rules come this way
 226   = lookupOccRn fn              `thenRn` \ fn' ->
 227     returnRn (IfaceRuleOut fn' rule)
 228
 229 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
 230   = pushSrcLocRn src_loc                                $
 231     bindPatSigTyVars (collectRuleBndrSigTys vars)       $
 232
 233     bindLocalsFVRn doc (map get_var vars)       $ \ ids ->
 234     mapFvRn rn_var (vars `zip` ids)             `thenRn` \ (vars', fv_vars) ->
 235
 236     rnExpr lhs                                  `thenRn` \ (lhs', fv_lhs) ->
 237     rnExpr rhs                                  `thenRn` \ (rhs', fv_rhs) ->
 238     checkRn (validRuleLhs ids lhs')
 239             (badRuleLhsErr rule_name lhs')      `thenRn_`
 240     let
 241         bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
 242     in
 243     mapRn (addErrRn . badRuleVar rule_name) bad_vars    `thenRn_`
 244     returnRn (HsRule rule_name act vars' lhs' rhs' src_loc,
 245               fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
 246   where
 247     doc = text "In the transformation rule" <+> ptext rule_name
 248
 249     get_var (RuleBndr v)      = v
 250     get_var (RuleBndrSig v _) = v
 251
 252     rn_var (RuleBndr v, id)      = returnRn (RuleBndr id, emptyFVs)
 253     rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t    `thenRn` \ (t', fvs) ->
 254                                    returnRn (RuleBndrSig id t', fvs)
 255 \end{code}
 256
 257
 258 %*********************************************************
 259 %*                                                      *
 260 \subsection{Type, class and iface sig declarations}
 261 %*                                                      *
 262 %*********************************************************
 263
 264 @rnTyDecl@ uses the `global name function' to create a new type
 265 declaration in which local names have been replaced by their original
 266 names, reporting any unknown names.
 267
 268 Renaming type variables is a pain. Because they now contain uniques,
 269 it is necessary to pass in an association list which maps a parsed
 270 tyvar to its @Name@ representation.
 271 In some cases (type signatures of values),
 272 it is even necessary to go over the type first
 273 in order to get the set of tyvars used by it, make an assoc list,
 274 and then go over it again to rename the tyvars!
 275 However, we can also do some scoping checks at the same time.
 276
 277 \begin{code}
 278 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
 279   = pushSrcLocRn loc $
 280     lookupTopBndrRn name                `thenRn` \ name' ->
 281     rnHsType doc_str ty                 `thenRn` \ ty' ->
 282     mapRn rnIdInfo id_infos             `thenRn` \ id_infos' ->
 283     returnRn (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
 284   where
 285     doc_str = text "In the interface signature for" <+> quotes (ppr name)
 286
 287 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
 288   = pushSrcLocRn loc                    $
 289     lookupTopBndrRn name                `thenRn` \ name' ->
 290     returnRn (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
 291
 292 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
 293                     tcdTyVars = tyvars, tcdCons = condecls, tcdNCons = nconstrs,
 294                     tcdLoc = src_loc, tcdSysNames = sys_names})
 295   = pushSrcLocRn src_loc $
 296     lookupTopBndrRn tycon                       `thenRn` \ tycon' ->
 297     bindTyVarsRn data_doc tyvars                $ \ tyvars' ->
 298     rnContext data_doc context                  `thenRn` \ context' ->
 299     checkDupOrQualNames data_doc con_names      `thenRn_`
 300
 301         -- Check that there's at least one condecl,
 302         -- or else we're reading an interface file, or -fglasgow-exts
 303     (if null condecls then
 304         doptRn Opt_GlasgowExts  `thenRn` \ glaExts ->
 305         getModeRn               `thenRn` \ mode ->
 306         checkRn (glaExts || isInterfaceMode mode)
 307                 (emptyConDeclsErr tycon)
 308      else returnRn ()
 309     )                                           `thenRn_`
 310
 311     mapRn rnConDecl condecls                    `thenRn` \ condecls' ->
 312     mapRn lookupSysBinder sys_names             `thenRn` \ sys_names' ->
 313     returnRn (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
 314                       tcdTyVars = tyvars', tcdCons = condecls', tcdNCons = nconstrs,
 315                       tcdDerivs = Nothing, tcdLoc = src_loc, tcdSysNames = sys_names'})
 316   where
 317     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 318     con_names = map conDeclName condecls
 319
 320 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
 321   = pushSrcLocRn src_loc $
 322     lookupTopBndrRn name                        `thenRn` \ name' ->
 323     bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
 324     rnHsType syn_doc ty                         `thenRn` \ ty' ->
 325     returnRn (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
 326   where
 327     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 328
 329 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
 330                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 331                        tcdSysNames = names, tcdLoc = src_loc})
 332         -- Used for both source and interface file decls
 333   = pushSrcLocRn src_loc $
 334
 335     lookupTopBndrRn cname                       `thenRn` \ cname' ->
 336
 337         -- Deal with the implicit tycon and datacon name
 338         -- They aren't in scope (because they aren't visible to the user)
 339         -- and what we want to do is simply look them up in the cache;
 340         -- we jolly well ought to get a 'hit' there!
 341     mapRn lookupSysBinder names                 `thenRn` \ names' ->
 342
 343         -- Tyvars scope over bindings and context
 344     bindTyVars2Rn cls_doc tyvars                $ \ clas_tyvar_names tyvars' ->
 345
 346         -- Check the superclasses
 347     rnContext cls_doc context                   `thenRn` \ context' ->
 348
 349         -- Check the functional dependencies
 350     rnFds cls_doc fds                           `thenRn` \ fds' ->
 351
 352         -- Check the signatures
 353         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 354     let
 355         (op_sigs, non_op_sigs) = partition isClassOpSig sigs
 356         sig_rdr_names_w_locs   = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
 357     in
 358     checkDupOrQualNames sig_doc sig_rdr_names_w_locs            `thenRn_`
 359     mapRn (rnClassOp cname' clas_tyvar_names fds') op_sigs      `thenRn` \ sigs' ->
 360     let
 361         binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
 362     in
 363     renameSigs (okClsDclSig binders) non_op_sigs          `thenRn` \ non_ops' ->
 364
 365         -- Typechecker is responsible for checking that we only
 366         -- give default-method bindings for things in this class.
 367         -- The renamer *could* check this for class decls, but can't
 368         -- for instance decls.
 369
 370     returnRn (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
 371                           tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
 372                           tcdSysNames = names', tcdLoc = src_loc})
 373   where
 374     cls_doc  = text "In the declaration for class"      <+> ppr cname
 375     sig_doc  = text "In the signatures for class"       <+> ppr cname
 376
 377 rnClassOp clas clas_tyvars clas_fds sig@(ClassOpSig op dm_stuff ty locn)
 378   = pushSrcLocRn locn $
 379     lookupTopBndrRn op                  `thenRn` \ op_name ->
 380
 381         -- Check the signature
 382     rnHsSigType (quotes (ppr op)) ty    `thenRn` \ new_ty ->
 383
 384         -- Make the default-method name
 385     (case dm_stuff of
 386         DefMeth dm_rdr_name
 387             ->  -- Imported class that has a default method decl
 388                 -- See comments with tname, snames, above
 389                 lookupSysBinder dm_rdr_name     `thenRn` \ dm_name ->
 390                 returnRn (DefMeth dm_name)
 391                         -- An imported class decl for a class decl that had an explicit default
 392                         -- method, mentions, rather than defines,
 393                         -- the default method, so we must arrange to pull it in
 394
 395         GenDefMeth -> returnRn GenDefMeth
 396         NoDefMeth  -> returnRn NoDefMeth
 397     )                                           `thenRn` \ dm_stuff' ->
 398
 399     returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
 400
 401 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
 402         -- Used for source file decls only
 403         -- Renames the default-bindings of a class decl
 404         --         the derivings of a data decl
 405 finishSourceTyClDecl (TyData {tcdDerivs = Just derivs, tcdLoc = src_loc})       -- Derivings in here
 406                      rn_ty_decl                                                 -- Everything else is here
 407   = pushSrcLocRn src_loc         $
 408     mapRn rnDeriv derivs        `thenRn` \ derivs' ->
 409     returnRn (rn_ty_decl {tcdDerivs = Just derivs'}, mkNameSet derivs')
 410
 411 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc})     -- Get mbinds from here
 412          rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars})            -- Everything else is here
 413   -- There are some default-method bindings (abeit possibly empty) so
 414   -- this is a source-code class declaration
 415   =     -- The newLocals call is tiresome: given a generic class decl
 416         --      class C a where
 417         --        op :: a -> a
 418         --        op {| x+y |} (Inl a) = ...
 419         --        op {| x+y |} (Inr b) = ...
 420         --        op {| a*b |} (a*b)   = ...
 421         -- we want to name both "x" tyvars with the same unique, so that they are
 422         -- easy to group together in the typechecker.
 423         -- Hence the
 424     pushSrcLocRn src_loc                                $
 425     extendTyVarEnvFVRn (map hsTyVarName tyvars)         $
 426     getLocalNameEnv                                     `thenRn` \ name_env ->
 427     let
 428         meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
 429         gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
 430                                                 not (tv `elemRdrEnv` name_env)]
 431     in
 432     checkDupOrQualNames meth_doc meth_rdr_names_w_locs  `thenRn_`
 433     newLocalsRn gen_rdr_tyvars_w_locs                   `thenRn` \ gen_tyvars ->
 434     rnMethodBinds cls gen_tyvars mbinds                 `thenRn` \ (mbinds', meth_fvs) ->
 435     returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
 436   where
 437     meth_doc = text "In the default-methods for class"  <+> ppr (tcdName rn_cls_decl)
 438
 439 finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
 440         -- Not a class or data type declaration
 441 \end{code}
 442
 443
 444 %*********************************************************
 445 %*                                                      *
 446 \subsection{Support code for type/data declarations}
 447 %*                                                      *
 448 %*********************************************************
 449
 450 \begin{code}
 451 rnDeriv :: RdrName -> RnMS Name
 452 rnDeriv cls
 453   = lookupOccRn cls     `thenRn` \ clas_name ->
 454     checkRn (getUnique clas_name `elem` derivableClassKeys)
 455             (derivingNonStdClassErr clas_name)  `thenRn_`
 456     returnRn clas_name
 457 \end{code}
 458
 459 \begin{code}
 460 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
 461 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
 462
 463 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
 464 rnConDecl (ConDecl name wkr tvs cxt details locn)
 465   = pushSrcLocRn locn $
 466     checkConName name           `thenRn_`
 467     lookupTopBndrRn name        `thenRn` \ new_name ->
 468
 469     lookupSysBinder wkr         `thenRn` \ new_wkr ->
 470         -- See comments with ClassDecl
 471
 472     bindTyVarsRn doc tvs                $ \ new_tyvars ->
 473     rnContext doc cxt                   `thenRn` \ new_context ->
 474     rnConDetails doc locn details       `thenRn` \ new_details ->
 475     returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
 476   where
 477     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 478
 479 rnConDetails doc locn (VanillaCon tys)
 480   = mapRn (rnBangTy doc) tys    `thenRn` \ new_tys  ->
 481     returnRn (VanillaCon new_tys)
 482
 483 rnConDetails doc locn (InfixCon ty1 ty2)
 484   = rnBangTy doc ty1            `thenRn` \ new_ty1 ->
 485     rnBangTy doc ty2            `thenRn` \ new_ty2 ->
 486     returnRn (InfixCon new_ty1 new_ty2)
 487
 488 rnConDetails doc locn (RecCon fields)
 489   = checkDupOrQualNames doc field_names `thenRn_`
 490     mapRn (rnField doc) fields          `thenRn` \ new_fields ->
 491     returnRn (RecCon new_fields)
 492   where
 493     field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
 494
 495 rnField doc (names, ty)
 496   = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
 497     rnBangTy doc ty             `thenRn` \ new_ty ->
 498     returnRn (new_names, new_ty)
 499
 500 rnBangTy doc (BangType s ty)
 501   = rnHsType doc ty             `thenRn` \ new_ty ->
 502     returnRn (BangType s new_ty)
 503
 504 -- This data decl will parse OK
 505 --      data T = a Int
 506 -- treating "a" as the constructor.
 507 -- It is really hard to make the parser spot this malformation.
 508 -- So the renamer has to check that the constructor is legal
 509 --
 510 -- We can get an operator as the constructor, even in the prefix form:
 511 --      data T = :% Int Int
 512 -- from interface files, which always print in prefix form
 513
 514 checkConName name
 515   = checkRn (isRdrDataCon name)
 516             (badDataCon name)
 517 \end{code}
 518
 519
 520 %*********************************************************
 521 %*                                                      *
 522 \subsection{Support code to rename types}
 523 %*                                                      *
 524 %*********************************************************
 525
 526 \begin{code}
 527 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
 528
 529 rnFds doc fds
 530   = mapRn rn_fds fds
 531   where
 532     rn_fds (tys1, tys2)
 533       = rnHsTyVars doc tys1             `thenRn` \ tys1' ->
 534         rnHsTyVars doc tys2             `thenRn` \ tys2' ->
 535         returnRn (tys1', tys2')
 536
 537 rnHsTyVars doc tvs  = mapRn (rnHsTyvar doc) tvs
 538 rnHsTyvar doc tyvar = lookupOccRn tyvar
 539 \end{code}
 540
 541 %*********************************************************
 542 %*                                                       *
 543 \subsection{IdInfo}
 544 %*                                                       *
 545 %*********************************************************
 546
 547 \begin{code}
 548 rnIdInfo (HsWorker worker arity)
 549   = lookupOccRn worker                  `thenRn` \ worker' ->
 550     returnRn (HsWorker worker' arity)
 551
 552 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
 553                                   returnRn (HsUnfold inline expr')
 554 rnIdInfo (HsStrictness str)     = returnRn (HsStrictness str)
 555 rnIdInfo (HsArity arity)        = returnRn (HsArity arity)
 556 rnIdInfo HsNoCafRefs            = returnRn HsNoCafRefs
 557 \end{code}
 558
 559 @UfCore@ expressions.
 560
 561 \begin{code}
 562 rnCoreExpr (UfType ty)
 563   = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
 564     returnRn (UfType ty')
 565
 566 rnCoreExpr (UfVar v)
 567   = lookupOccRn v       `thenRn` \ v' ->
 568     returnRn (UfVar v')
 569
 570 rnCoreExpr (UfLit l)
 571   = returnRn (UfLit l)
 572
 573 rnCoreExpr (UfLitLit l ty)
 574   = rnHsType (text "litlit") ty `thenRn` \ ty' ->
 575     returnRn (UfLitLit l ty')
 576
 577 rnCoreExpr (UfFCall cc ty)
 578   = rnHsType (text "ccall") ty  `thenRn` \ ty' ->
 579     returnRn (UfFCall cc ty')
 580
 581 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
 582   = mapRn rnCoreExpr args               `thenRn` \ args' ->
 583     returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
 584   where
 585     tup_name = getName (dataConId (tupleCon boxity arity))
 586         -- Get the *worker* name and use that
 587
 588 rnCoreExpr (UfApp fun arg)
 589   = rnCoreExpr fun              `thenRn` \ fun' ->
 590     rnCoreExpr arg              `thenRn` \ arg' ->
 591     returnRn (UfApp fun' arg')
 592
 593 rnCoreExpr (UfCase scrut bndr alts)
 594   = rnCoreExpr scrut                    `thenRn` \ scrut' ->
 595     bindCoreLocalRn bndr                $ \ bndr' ->
 596     mapRn rnCoreAlt alts                `thenRn` \ alts' ->
 597     returnRn (UfCase scrut' bndr' alts')
 598
 599 rnCoreExpr (UfNote note expr)
 600   = rnNote note                 `thenRn` \ note' ->
 601     rnCoreExpr expr             `thenRn` \ expr' ->
 602     returnRn  (UfNote note' expr')
 603
 604 rnCoreExpr (UfLam bndr body)
 605   = rnCoreBndr bndr             $ \ bndr' ->
 606     rnCoreExpr body             `thenRn` \ body' ->
 607     returnRn (UfLam bndr' body')
 608
 609 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
 610   = rnCoreExpr rhs              `thenRn` \ rhs' ->
 611     rnCoreBndr bndr             $ \ bndr' ->
 612     rnCoreExpr body             `thenRn` \ body' ->
 613     returnRn (UfLet (UfNonRec bndr' rhs') body')
 614
 615 rnCoreExpr (UfLet (UfRec pairs) body)
 616   = rnCoreBndrs bndrs           $ \ bndrs' ->
 617     mapRn rnCoreExpr rhss       `thenRn` \ rhss' ->
 618     rnCoreExpr body             `thenRn` \ body' ->
 619     returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
 620   where
 621     (bndrs, rhss) = unzip pairs
 622 \end{code}
 623
 624 \begin{code}
 625 rnCoreBndr (UfValBinder name ty) thing_inside
 626   = rnHsType doc ty             `thenRn` \ ty' ->
 627     bindCoreLocalRn name        $ \ name' ->
 628     thing_inside (UfValBinder name' ty')
 629   where
 630     doc = text "unfolding id"
 631
 632 rnCoreBndr (UfTyBinder name kind) thing_inside
 633   = bindCoreLocalRn name                $ \ name' ->
 634     thing_inside (UfTyBinder name' kind)
 635
 636 rnCoreBndrs []     thing_inside = thing_inside []
 637 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b          $ \ name' ->
 638                                   rnCoreBndrs bs        $ \ names' ->
 639                                   thing_inside (name':names')
 640 \end{code}
 641
 642 \begin{code}
 643 rnCoreAlt (con, bndrs, rhs)
 644   = rnUfCon con                         `thenRn` \ con' ->
 645     bindCoreLocalsRn bndrs              $ \ bndrs' ->
 646     rnCoreExpr rhs                      `thenRn` \ rhs' ->
 647     returnRn (con', bndrs', rhs')
 648
 649 rnNote (UfCoerce ty)
 650   = rnHsType (text "unfolding coerce") ty       `thenRn` \ ty' ->
 651     returnRn (UfCoerce ty')
 652
 653 rnNote (UfSCC cc)   = returnRn (UfSCC cc)
 654 rnNote UfInlineCall = returnRn UfInlineCall
 655 rnNote UfInlineMe   = returnRn UfInlineMe
 656
 657
 658 rnUfCon UfDefault
 659   = returnRn UfDefault
 660
 661 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
 662   = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
 663   where
 664     tup_name = getName (tupleCon boxity arity)
 665
 666 rnUfCon (UfDataAlt con)
 667   = lookupOccRn con             `thenRn` \ con' ->
 668     returnRn (UfDataAlt con')
 669
 670 rnUfCon (UfLitAlt lit)
 671   = returnRn (UfLitAlt lit)
 672
 673 rnUfCon (UfLitLitAlt lit ty)
 674   = rnHsType (text "litlit") ty         `thenRn` \ ty' ->
 675     returnRn (UfLitLitAlt lit ty')
 676 \end{code}
 677
 678 %*********************************************************
 679 %*                                                       *
 680 \subsection{Rule shapes}
 681 %*                                                       *
 682 %*********************************************************
 683
 684 Check the shape of a transformation rule LHS.  Currently
 685 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
 686 not one of the @forall@'d variables.
 687
 688 \begin{code}
 689 validRuleLhs foralls lhs
 690   = check lhs
 691   where
 692     check (OpApp _ op _ _)                = check op
 693     check (HsApp e1 e2)                   = check e1
 694     check (HsVar v) | v `notElem` foralls = True
 695     check other                           = False
 696 \end{code}
 697
 698
 699 %*********************************************************
 700 %*                                                       *
 701 \subsection{Errors}
 702 %*                                                       *
 703 %*********************************************************
 704
 705 \begin{code}
 706 derivingNonStdClassErr clas
 707   = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
 708
 709 badDataCon name
 710    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 711 badRuleLhsErr name lhs
 712   = sep [ptext SLIT("Rule") <+> ptext name <> colon,
 713          nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
 714     $$
 715     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
 716
 717 badRuleVar name var
 718   = sep [ptext SLIT("Rule") <+> doubleQuotes (ptext name) <> colon,
 719          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
 720                 ptext SLIT("does not appear on left hand side")]
 721
 722 emptyConDeclsErr tycon
 723   = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
 724          nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
 725 \end{code}