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 \end{code}
  49
  50 @rnSourceDecl@ `renames' declarations.
  51 It simultaneously performs dependency analysis and precedence parsing.
  52 It also does the following error checks:
  53 \begin{enumerate}
  54 \item
  55 Checks that tyvars are used properly. This includes checking
  56 for undefined tyvars, and tyvars in contexts that are ambiguous.
  57 (Some of this checking has now been moved to module @TcMonoType@,
  58 since we don't have functional dependency information at this point.)
  59 \item
  60 Checks that all variable occurences are defined.
  61 \item
  62 Checks the @(..)@ etc constraints in the export list.
  63 \end{enumerate}
  64
  65
  66 %*********************************************************
  67 %*                                                      *
  68 \subsection{Source code declarations}
  69 %*                                                      *
  70 %*********************************************************
  71
  72 \begin{code}
  73 rnSourceDecls :: GlobalRdrEnv -> AvailEnv -> LocalFixityEnv
  74               -> [RdrNameHsDecl]
  75               -> RnMG ([RenamedHsDecl], FreeVars)
  76         -- The decls get reversed, but that's ok
  77
  78 rnSourceDecls gbl_env avails local_fixity_env decls
  79   = initRnMS gbl_env avails emptyRdrEnv local_fixity_env SourceMode (go emptyFVs [] decls)
  80   where
  81         -- Fixity and deprecations have been dealt with already; ignore them
  82     go fvs ds' []             = returnRn (ds', fvs)
  83     go fvs ds' (FixD _:ds)    = go fvs ds' ds
  84     go fvs ds' (DeprecD _:ds) = go fvs ds' ds
  85     go fvs ds' (d:ds)         = rnSourceDecl d  `thenRn` \(d', fvs') ->
  86                                 go (fvs `plusFV` fvs') (d':ds') ds
  87
  88
  89 rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
  90
  91 rnSourceDecl (ValD binds) = rnTopBinds binds    `thenRn` \ (new_binds, fvs) ->
  92                             returnRn (ValD new_binds, fvs)
  93
  94 rnSourceDecl (TyClD tycl_decl)
  95   = rnTyClDecl tycl_decl                        `thenRn` \ new_decl ->
  96     finishSourceTyClDecl tycl_decl new_decl     `thenRn` \ (new_decl', fvs) ->
  97     returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
  98
  99 rnSourceDecl (InstD inst)
 100   = rnInstDecl inst                     `thenRn` \ new_inst ->
 101     finishSourceInstDecl inst new_inst  `thenRn` \ (new_inst', fvs) ->
 102     returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
 103
 104 rnSourceDecl (RuleD rule)
 105   = rnHsRuleDecl rule           `thenRn` \ (new_rule, fvs) ->
 106     returnRn (RuleD new_rule, fvs)
 107
 108 rnSourceDecl (ForD ford)
 109   = rnHsForeignDecl ford                `thenRn` \ (new_ford, fvs) ->
 110     returnRn (ForD new_ford, fvs)
 111
 112 rnSourceDecl (DefD (DefaultDecl tys src_loc))
 113   = pushSrcLocRn src_loc $
 114     mapFvRn (rnHsTypeFVs doc_str) tys           `thenRn` \ (tys', fvs) ->
 115     returnRn (DefD (DefaultDecl tys' src_loc), fvs)
 116   where
 117     doc_str = text "In a `default' declaration"
 118 \end{code}
 119
 120
 121 %*********************************************************
 122 %*                                                      *
 123 \subsection{Foreign declarations}
 124 %*                                                      *
 125 %*********************************************************
 126
 127 \begin{code}
 128 rnHsForeignDecl (ForeignImport name ty spec isDeprec src_loc)
 129   = pushSrcLocRn src_loc                $
 130     lookupTopBndrRn name                `thenRn` \ name' ->
 131     rnHsTypeFVs (fo_decl_msg name) ty   `thenRn` \ (ty', fvs) ->
 132     returnRn (ForeignImport name' ty' spec isDeprec src_loc,
 133               fvs `plusFV` extras spec)
 134   where
 135     extras (CImport _ _ _ _ CWrapper) = mkFVs [newStablePtrName,
 136                                                deRefStablePtrName,
 137                                                bindIOName, returnIOName]
 138     extras _                          = emptyFVs
 139
 140 rnHsForeignDecl (ForeignExport name ty spec isDeprec 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 isDeprec 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                     tcdDerivs = derivs, 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     rn_derivs derivs                            `thenRn` \ derivs' ->
 300     checkDupOrQualNames data_doc con_names      `thenRn_`
 301
 302         -- Check that there's at least one condecl,
 303         -- or else we're reading an interface file, or -fglasgow-exts
 304     (if null condecls then
 305         doptRn Opt_GlasgowExts  `thenRn` \ glaExts ->
 306         getModeRn               `thenRn` \ mode ->
 307         checkRn (glaExts || isInterfaceMode mode)
 308                 (emptyConDeclsErr tycon)
 309      else returnRn ()
 310     )                                           `thenRn_`
 311
 312     mapRn rnConDecl condecls                    `thenRn` \ condecls' ->
 313     mapRn lookupSysBinder sys_names             `thenRn` \ sys_names' ->
 314     returnRn (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
 315                       tcdTyVars = tyvars', tcdCons = condecls', tcdNCons = nconstrs,
 316                       tcdDerivs = derivs', tcdLoc = src_loc, tcdSysNames = sys_names'})
 317   where
 318     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 319     con_names = map conDeclName condecls
 320
 321     rn_derivs Nothing   = returnRn Nothing
 322     rn_derivs (Just ds) = rnContext data_doc ds `thenRn` \ ds' -> returnRn (Just ds')
 323
 324 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
 325   = pushSrcLocRn src_loc $
 326     lookupTopBndrRn name                        `thenRn` \ name' ->
 327     bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
 328     rnHsType syn_doc ty                         `thenRn` \ ty' ->
 329     returnRn (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
 330   where
 331     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 332
 333 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
 334                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 335                        tcdSysNames = names, tcdLoc = src_loc})
 336         -- Used for both source and interface file decls
 337   = pushSrcLocRn src_loc $
 338
 339     lookupTopBndrRn cname                       `thenRn` \ cname' ->
 340
 341         -- Deal with the implicit tycon and datacon name
 342         -- They aren't in scope (because they aren't visible to the user)
 343         -- and what we want to do is simply look them up in the cache;
 344         -- we jolly well ought to get a 'hit' there!
 345     mapRn lookupSysBinder names                 `thenRn` \ names' ->
 346
 347         -- Tyvars scope over bindings and context
 348     bindTyVarsRn cls_doc tyvars                 $ \ tyvars' ->
 349
 350         -- Check the superclasses
 351     rnContext cls_doc context                   `thenRn` \ context' ->
 352
 353         -- Check the functional dependencies
 354     rnFds cls_doc fds                           `thenRn` \ fds' ->
 355
 356         -- Check the signatures
 357         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 358     let
 359         (op_sigs, non_op_sigs) = partition isClassOpSig sigs
 360         sig_rdr_names_w_locs   = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
 361     in
 362     checkDupOrQualNames sig_doc sig_rdr_names_w_locs    `thenRn_`
 363     mapRn (rnClassOp cname' fds') op_sigs               `thenRn` \ sigs' ->
 364     let
 365         binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
 366     in
 367     renameSigs (okClsDclSig binders) non_op_sigs          `thenRn` \ non_ops' ->
 368
 369         -- Typechecker is responsible for checking that we only
 370         -- give default-method bindings for things in this class.
 371         -- The renamer *could* check this for class decls, but can't
 372         -- for instance decls.
 373
 374     returnRn (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
 375                           tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
 376                           tcdSysNames = names', tcdLoc = src_loc})
 377   where
 378     cls_doc  = text "In the declaration for class"      <+> ppr cname
 379     sig_doc  = text "In the signatures for class"       <+> ppr cname
 380
 381 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
 382   = pushSrcLocRn locn $
 383     lookupTopBndrRn op                  `thenRn` \ op_name ->
 384
 385         -- Check the signature
 386     rnHsSigType (quotes (ppr op)) ty    `thenRn` \ new_ty ->
 387
 388         -- Make the default-method name
 389     (case dm_stuff of
 390         DefMeth dm_rdr_name
 391             ->  -- Imported class that has a default method decl
 392                 -- See comments with tname, snames, above
 393                 lookupSysBinder dm_rdr_name     `thenRn` \ dm_name ->
 394                 returnRn (DefMeth dm_name)
 395                         -- An imported class decl for a class decl that had an explicit default
 396                         -- method, mentions, rather than defines,
 397                         -- the default method, so we must arrange to pull it in
 398
 399         GenDefMeth -> returnRn GenDefMeth
 400         NoDefMeth  -> returnRn NoDefMeth
 401     )                                           `thenRn` \ dm_stuff' ->
 402
 403     returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
 404
 405 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
 406         -- Used for source file decls only
 407         -- Renames the default-bindings of a class decl
 408 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc})     -- Get mbinds from here
 409          rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars})            -- Everything else is here
 410   -- There are some default-method bindings (abeit possibly empty) so
 411   -- this is a source-code class declaration
 412   =     -- The newLocals call is tiresome: given a generic class decl
 413         --      class C a where
 414         --        op :: a -> a
 415         --        op {| x+y |} (Inl a) = ...
 416         --        op {| x+y |} (Inr b) = ...
 417         --        op {| a*b |} (a*b)   = ...
 418         -- we want to name both "x" tyvars with the same unique, so that they are
 419         -- easy to group together in the typechecker.
 420         -- Hence the
 421     pushSrcLocRn src_loc                                $
 422     extendTyVarEnvFVRn (map hsTyVarName tyvars)         $
 423     getLocalNameEnv                                     `thenRn` \ name_env ->
 424     let
 425         meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
 426         gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
 427                                                 not (tv `elemRdrEnv` name_env)]
 428     in
 429     checkDupOrQualNames meth_doc meth_rdr_names_w_locs  `thenRn_`
 430     newLocalsRn gen_rdr_tyvars_w_locs                   `thenRn` \ gen_tyvars ->
 431     rnMethodBinds cls gen_tyvars mbinds                 `thenRn` \ (mbinds', meth_fvs) ->
 432     returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
 433   where
 434     meth_doc = text "In the default-methods for class"  <+> ppr (tcdName rn_cls_decl)
 435
 436 finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
 437         -- Not a class declaration
 438 \end{code}
 439
 440
 441 %*********************************************************
 442 %*                                                      *
 443 \subsection{Support code for type/data declarations}
 444 %*                                                      *
 445 %*********************************************************
 446
 447 \begin{code}
 448 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
 449 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
 450
 451 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
 452 rnConDecl (ConDecl name wkr tvs cxt details locn)
 453   = pushSrcLocRn locn $
 454     checkConName name           `thenRn_`
 455     lookupTopBndrRn name        `thenRn` \ new_name ->
 456
 457     lookupSysBinder wkr         `thenRn` \ new_wkr ->
 458         -- See comments with ClassDecl
 459
 460     bindTyVarsRn doc tvs                $ \ new_tyvars ->
 461     rnContext doc cxt                   `thenRn` \ new_context ->
 462     rnConDetails doc locn details       `thenRn` \ new_details ->
 463     returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
 464   where
 465     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 466
 467 rnConDetails doc locn (VanillaCon tys)
 468   = mapRn (rnBangTy doc) tys    `thenRn` \ new_tys  ->
 469     returnRn (VanillaCon new_tys)
 470
 471 rnConDetails doc locn (InfixCon ty1 ty2)
 472   = rnBangTy doc ty1            `thenRn` \ new_ty1 ->
 473     rnBangTy doc ty2            `thenRn` \ new_ty2 ->
 474     returnRn (InfixCon new_ty1 new_ty2)
 475
 476 rnConDetails doc locn (RecCon fields)
 477   = checkDupOrQualNames doc field_names `thenRn_`
 478     mapRn (rnField doc) fields          `thenRn` \ new_fields ->
 479     returnRn (RecCon new_fields)
 480   where
 481     field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
 482
 483 rnField doc (names, ty)
 484   = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
 485     rnBangTy doc ty             `thenRn` \ new_ty ->
 486     returnRn (new_names, new_ty)
 487
 488 rnBangTy doc (BangType s ty)
 489   = rnHsType doc ty             `thenRn` \ new_ty ->
 490     returnRn (BangType s new_ty)
 491
 492 -- This data decl will parse OK
 493 --      data T = a Int
 494 -- treating "a" as the constructor.
 495 -- It is really hard to make the parser spot this malformation.
 496 -- So the renamer has to check that the constructor is legal
 497 --
 498 -- We can get an operator as the constructor, even in the prefix form:
 499 --      data T = :% Int Int
 500 -- from interface files, which always print in prefix form
 501
 502 checkConName name
 503   = checkRn (isRdrDataCon name)
 504             (badDataCon name)
 505 \end{code}
 506
 507
 508 %*********************************************************
 509 %*                                                      *
 510 \subsection{Support code to rename types}
 511 %*                                                      *
 512 %*********************************************************
 513
 514 \begin{code}
 515 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
 516
 517 rnFds doc fds
 518   = mapRn rn_fds fds
 519   where
 520     rn_fds (tys1, tys2)
 521       = rnHsTyVars doc tys1             `thenRn` \ tys1' ->
 522         rnHsTyVars doc tys2             `thenRn` \ tys2' ->
 523         returnRn (tys1', tys2')
 524
 525 rnHsTyVars doc tvs  = mapRn (rnHsTyvar doc) tvs
 526 rnHsTyvar doc tyvar = lookupOccRn tyvar
 527 \end{code}
 528
 529 %*********************************************************
 530 %*                                                       *
 531 \subsection{IdInfo}
 532 %*                                                       *
 533 %*********************************************************
 534
 535 \begin{code}
 536 rnIdInfo (HsWorker worker arity)
 537   = lookupOccRn worker                  `thenRn` \ worker' ->
 538     returnRn (HsWorker worker' arity)
 539
 540 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
 541                                   returnRn (HsUnfold inline expr')
 542 rnIdInfo (HsStrictness str)     = returnRn (HsStrictness str)
 543 rnIdInfo (HsArity arity)        = returnRn (HsArity arity)
 544 rnIdInfo HsNoCafRefs            = returnRn HsNoCafRefs
 545 \end{code}
 546
 547 @UfCore@ expressions.
 548
 549 \begin{code}
 550 rnCoreExpr (UfType ty)
 551   = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
 552     returnRn (UfType ty')
 553
 554 rnCoreExpr (UfVar v)
 555   = lookupOccRn v       `thenRn` \ v' ->
 556     returnRn (UfVar v')
 557
 558 rnCoreExpr (UfLit l)
 559   = returnRn (UfLit l)
 560
 561 rnCoreExpr (UfLitLit l ty)
 562   = rnHsType (text "litlit") ty `thenRn` \ ty' ->
 563     returnRn (UfLitLit l ty')
 564
 565 rnCoreExpr (UfFCall cc ty)
 566   = rnHsType (text "ccall") ty  `thenRn` \ ty' ->
 567     returnRn (UfFCall cc ty')
 568
 569 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
 570   = mapRn rnCoreExpr args               `thenRn` \ args' ->
 571     returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
 572   where
 573     tup_name = getName (dataConId (tupleCon boxity arity))
 574         -- Get the *worker* name and use that
 575
 576 rnCoreExpr (UfApp fun arg)
 577   = rnCoreExpr fun              `thenRn` \ fun' ->
 578     rnCoreExpr arg              `thenRn` \ arg' ->
 579     returnRn (UfApp fun' arg')
 580
 581 rnCoreExpr (UfCase scrut bndr alts)
 582   = rnCoreExpr scrut                    `thenRn` \ scrut' ->
 583     bindCoreLocalRn bndr                $ \ bndr' ->
 584     mapRn rnCoreAlt alts                `thenRn` \ alts' ->
 585     returnRn (UfCase scrut' bndr' alts')
 586
 587 rnCoreExpr (UfNote note expr)
 588   = rnNote note                 `thenRn` \ note' ->
 589     rnCoreExpr expr             `thenRn` \ expr' ->
 590     returnRn  (UfNote note' expr')
 591
 592 rnCoreExpr (UfLam bndr body)
 593   = rnCoreBndr bndr             $ \ bndr' ->
 594     rnCoreExpr body             `thenRn` \ body' ->
 595     returnRn (UfLam bndr' body')
 596
 597 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
 598   = rnCoreExpr rhs              `thenRn` \ rhs' ->
 599     rnCoreBndr bndr             $ \ bndr' ->
 600     rnCoreExpr body             `thenRn` \ body' ->
 601     returnRn (UfLet (UfNonRec bndr' rhs') body')
 602
 603 rnCoreExpr (UfLet (UfRec pairs) body)
 604   = rnCoreBndrs bndrs           $ \ bndrs' ->
 605     mapRn rnCoreExpr rhss       `thenRn` \ rhss' ->
 606     rnCoreExpr body             `thenRn` \ body' ->
 607     returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
 608   where
 609     (bndrs, rhss) = unzip pairs
 610 \end{code}
 611
 612 \begin{code}
 613 rnCoreBndr (UfValBinder name ty) thing_inside
 614   = rnHsType doc ty             `thenRn` \ ty' ->
 615     bindCoreLocalRn name        $ \ name' ->
 616     thing_inside (UfValBinder name' ty')
 617   where
 618     doc = text "unfolding id"
 619
 620 rnCoreBndr (UfTyBinder name kind) thing_inside
 621   = bindCoreLocalRn name                $ \ name' ->
 622     thing_inside (UfTyBinder name' kind)
 623
 624 rnCoreBndrs []     thing_inside = thing_inside []
 625 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b          $ \ name' ->
 626                                   rnCoreBndrs bs        $ \ names' ->
 627                                   thing_inside (name':names')
 628 \end{code}
 629
 630 \begin{code}
 631 rnCoreAlt (con, bndrs, rhs)
 632   = rnUfCon con                         `thenRn` \ con' ->
 633     bindCoreLocalsRn bndrs              $ \ bndrs' ->
 634     rnCoreExpr rhs                      `thenRn` \ rhs' ->
 635     returnRn (con', bndrs', rhs')
 636
 637 rnNote (UfCoerce ty)
 638   = rnHsType (text "unfolding coerce") ty       `thenRn` \ ty' ->
 639     returnRn (UfCoerce ty')
 640
 641 rnNote (UfSCC cc)   = returnRn (UfSCC cc)
 642 rnNote UfInlineCall = returnRn UfInlineCall
 643 rnNote UfInlineMe   = returnRn UfInlineMe
 644
 645
 646 rnUfCon UfDefault
 647   = returnRn UfDefault
 648
 649 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
 650   = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
 651   where
 652     tup_name = getName (tupleCon boxity arity)
 653
 654 rnUfCon (UfDataAlt con)
 655   = lookupOccRn con             `thenRn` \ con' ->
 656     returnRn (UfDataAlt con')
 657
 658 rnUfCon (UfLitAlt lit)
 659   = returnRn (UfLitAlt lit)
 660
 661 rnUfCon (UfLitLitAlt lit ty)
 662   = rnHsType (text "litlit") ty         `thenRn` \ ty' ->
 663     returnRn (UfLitLitAlt lit ty')
 664 \end{code}
 665
 666 %*********************************************************
 667 %*                                                       *
 668 \subsection{Rule shapes}
 669 %*                                                       *
 670 %*********************************************************
 671
 672 Check the shape of a transformation rule LHS.  Currently
 673 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
 674 not one of the @forall@'d variables.
 675
 676 \begin{code}
 677 validRuleLhs foralls lhs
 678   = check lhs
 679   where
 680     check (OpApp _ op _ _)                = check op
 681     check (HsApp e1 e2)                   = check e1
 682     check (HsVar v) | v `notElem` foralls = True
 683     check other                           = False
 684 \end{code}
 685
 686
 687 %*********************************************************
 688 %*                                                       *
 689 \subsection{Errors}
 690 %*                                                       *
 691 %*********************************************************
 692
 693 \begin{code}
 694 badDataCon name
 695    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 696
 697 badRuleLhsErr name lhs
 698   = sep [ptext SLIT("Rule") <+> ptext name <> colon,
 699          nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
 700     $$
 701     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
 702
 703 badRuleVar name var
 704   = sep [ptext SLIT("Rule") <+> doubleQuotes (ptext name) <> colon,
 705          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
 706                 ptext SLIT("does not appear on left hand side")]
 707
 708 emptyConDeclsErr tycon
 709   = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
 710          nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
 711 \end{code}