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