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