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