ghc/compiler/rename/RnSource.lhs

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