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 TyCon            ( DataConDetails(..), visibleDataCons )
  36 import DataCon          ( dataConId )
  37 import Name             ( Name, NamedThing(..) )
  38 import NameSet
  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 Maybes           ( maybeToBool )
  49 import Maybe            ( maybe )
  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,
 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     rnConDecls tycon' condecls                  `thenRn` \ condecls' ->
 305     mapRn lookupSysBinder sys_names             `thenRn` \ sys_names' ->
 306     returnRn (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
 307                       tcdTyVars = tyvars', tcdCons = condecls',
 308                       tcdDerivs = derivs', tcdLoc = src_loc, tcdSysNames = sys_names'})
 309   where
 310     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 311     con_names = map conDeclName (visibleDataCons condecls)
 312
 313     rn_derivs Nothing   = returnRn Nothing
 314     rn_derivs (Just ds) = rnContext data_doc ds `thenRn` \ ds' -> returnRn (Just ds')
 315
 316 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
 317   = pushSrcLocRn src_loc $
 318     lookupTopBndrRn name                        `thenRn` \ name' ->
 319     bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
 320     rnHsType syn_doc ty                         `thenRn` \ ty' ->
 321     returnRn (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
 322   where
 323     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 324
 325 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
 326                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 327                        tcdSysNames = names, tcdLoc = src_loc})
 328         -- Used for both source and interface file decls
 329   = pushSrcLocRn src_loc $
 330
 331     lookupTopBndrRn cname                       `thenRn` \ cname' ->
 332
 333         -- Deal with the implicit tycon and datacon name
 334         -- They aren't in scope (because they aren't visible to the user)
 335         -- and what we want to do is simply look them up in the cache;
 336         -- we jolly well ought to get a 'hit' there!
 337     mapRn lookupSysBinder names                 `thenRn` \ names' ->
 338
 339         -- Tyvars scope over bindings and context
 340     bindTyVarsRn cls_doc tyvars                 $ \ tyvars' ->
 341
 342         -- Check the superclasses
 343     rnContext cls_doc context                   `thenRn` \ context' ->
 344
 345         -- Check the functional dependencies
 346     rnFds cls_doc fds                           `thenRn` \ fds' ->
 347
 348         -- Check the signatures
 349         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 350     let
 351         (op_sigs, non_op_sigs) = partition isClassOpSig sigs
 352         sig_rdr_names_w_locs   = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
 353     in
 354     checkDupOrQualNames sig_doc sig_rdr_names_w_locs    `thenRn_`
 355     mapRn (rnClassOp cname' fds') op_sigs               `thenRn` \ sigs' ->
 356     let
 357         binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
 358     in
 359     renameSigs (okClsDclSig binders) non_op_sigs          `thenRn` \ non_ops' ->
 360
 361         -- Typechecker is responsible for checking that we only
 362         -- give default-method bindings for things in this class.
 363         -- The renamer *could* check this for class decls, but can't
 364         -- for instance decls.
 365
 366     returnRn (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
 367                           tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
 368                           tcdSysNames = names', tcdLoc = src_loc})
 369   where
 370     cls_doc  = text "In the declaration for class"      <+> ppr cname
 371     sig_doc  = text "In the signatures for class"       <+> ppr cname
 372
 373 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
 374   = pushSrcLocRn locn $
 375     lookupTopBndrRn op                  `thenRn` \ op_name ->
 376
 377         -- Check the signature
 378     rnHsSigType (quotes (ppr op)) ty    `thenRn` \ new_ty ->
 379
 380         -- Make the default-method name
 381     (case dm_stuff of
 382         DefMeth dm_rdr_name
 383             ->  -- Imported class that has a default method decl
 384                 -- See comments with tname, snames, above
 385                 lookupSysBinder dm_rdr_name     `thenRn` \ dm_name ->
 386                 returnRn (DefMeth dm_name)
 387                         -- An imported class decl for a class decl that had an explicit default
 388                         -- method, mentions, rather than defines,
 389                         -- the default method, so we must arrange to pull it in
 390
 391         GenDefMeth -> returnRn GenDefMeth
 392         NoDefMeth  -> returnRn NoDefMeth
 393     )                                           `thenRn` \ dm_stuff' ->
 394
 395     returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
 396
 397 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
 398         -- Used for source file decls only
 399         -- Renames the default-bindings of a class decl
 400 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc})     -- Get mbinds from here
 401          rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars})            -- Everything else is here
 402   -- There are some default-method bindings (abeit possibly empty) so
 403   -- this is a source-code class declaration
 404   =     -- The newLocals call is tiresome: given a generic class decl
 405         --      class C a where
 406         --        op :: a -> a
 407         --        op {| x+y |} (Inl a) = ...
 408         --        op {| x+y |} (Inr b) = ...
 409         --        op {| a*b |} (a*b)   = ...
 410         -- we want to name both "x" tyvars with the same unique, so that they are
 411         -- easy to group together in the typechecker.
 412         -- Hence the
 413     pushSrcLocRn src_loc                                $
 414     extendTyVarEnvFVRn (map hsTyVarName tyvars)         $
 415     getLocalNameEnv                                     `thenRn` \ name_env ->
 416     let
 417         meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
 418         gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
 419                                                 not (tv `elemRdrEnv` name_env)]
 420     in
 421     checkDupOrQualNames meth_doc meth_rdr_names_w_locs  `thenRn_`
 422     newLocalsRn gen_rdr_tyvars_w_locs                   `thenRn` \ gen_tyvars ->
 423     rnMethodBinds cls gen_tyvars mbinds                 `thenRn` \ (mbinds', meth_fvs) ->
 424     returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
 425   where
 426     meth_doc = text "In the default-methods for class"  <+> ppr (tcdName rn_cls_decl)
 427
 428 finishSourceTyClDecl _ tycl_decl@(TyData {tcdDerivs = derivings})
 429   -- Derivings are returned here so that they don't form part of the tyClDeclFVs.
 430   -- This is important, because tyClDeclFVs should contain only the
 431   -- FVs that are `needed' by the interface file declaration, and
 432   -- derivings do not appear in this.  It also means that the tcGroups
 433   -- are smaller, which turned out to be important for the usage inference. KSW 2002-02.
 434   = returnRn (tycl_decl,
 435               maybe emptyFVs extractHsCtxtTyNames derivings)
 436
 437 finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
 438         -- Not a class declaration
 439 \end{code}
 440
 441
 442 %*********************************************************
 443 %*                                                      *
 444 \subsection{Support code for type/data declarations}
 445 %*                                                      *
 446 %*********************************************************
 447
 448 \begin{code}
 449 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
 450 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
 451
 452 rnConDecls :: Name -> DataConDetails RdrNameConDecl -> RnMS (DataConDetails RenamedConDecl)
 453 rnConDecls tycon Unknown     = returnRn Unknown
 454 rnConDecls tycon (HasCons n) = returnRn (HasCons n)
 455 rnConDecls tycon (DataCons condecls)
 456   =     -- Check that there's at least one condecl,
 457         -- or else we're reading an interface file, or -fglasgow-exts
 458     (if null condecls then
 459         doptRn Opt_GlasgowExts  `thenRn` \ glaExts ->
 460         getModeRn               `thenRn` \ mode ->
 461         checkRn (glaExts || isInterfaceMode mode)
 462                 (emptyConDeclsErr tycon)
 463      else returnRn ()
 464     )                                           `thenRn_`
 465
 466     mapRn rnConDecl condecls                    `thenRn` \ condecls' ->
 467     returnRn (DataCons condecls')
 468
 469 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
 470 rnConDecl (ConDecl name wkr tvs cxt details locn)
 471   = pushSrcLocRn locn $
 472     checkConName name           `thenRn_`
 473     lookupTopBndrRn name        `thenRn` \ new_name ->
 474
 475     lookupSysBinder wkr         `thenRn` \ new_wkr ->
 476         -- See comments with ClassDecl
 477
 478     bindTyVarsRn doc tvs                $ \ new_tyvars ->
 479     rnContext doc cxt                   `thenRn` \ new_context ->
 480     rnConDetails doc locn details       `thenRn` \ new_details ->
 481     returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
 482   where
 483     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 484
 485 rnConDetails doc locn (VanillaCon tys)
 486   = mapRn (rnBangTy doc) tys    `thenRn` \ new_tys  ->
 487     returnRn (VanillaCon new_tys)
 488
 489 rnConDetails doc locn (InfixCon ty1 ty2)
 490   = rnBangTy doc ty1            `thenRn` \ new_ty1 ->
 491     rnBangTy doc ty2            `thenRn` \ new_ty2 ->
 492     returnRn (InfixCon new_ty1 new_ty2)
 493
 494 rnConDetails doc locn (RecCon fields)
 495   = checkDupOrQualNames doc field_names `thenRn_`
 496     mapRn (rnField doc) fields          `thenRn` \ new_fields ->
 497     returnRn (RecCon new_fields)
 498   where
 499     field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
 500
 501 rnField doc (names, ty)
 502   = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
 503     rnBangTy doc ty             `thenRn` \ new_ty ->
 504     returnRn (new_names, new_ty)
 505
 506 rnBangTy doc (BangType s ty)
 507   = rnHsType doc ty             `thenRn` \ new_ty ->
 508     returnRn (BangType s new_ty)
 509
 510 -- This data decl will parse OK
 511 --      data T = a Int
 512 -- treating "a" as the constructor.
 513 -- It is really hard to make the parser spot this malformation.
 514 -- So the renamer has to check that the constructor is legal
 515 --
 516 -- We can get an operator as the constructor, even in the prefix form:
 517 --      data T = :% Int Int
 518 -- from interface files, which always print in prefix form
 519
 520 checkConName name
 521   = checkRn (isRdrDataCon name)
 522             (badDataCon name)
 523 \end{code}
 524
 525
 526 %*********************************************************
 527 %*                                                      *
 528 \subsection{Support code to rename types}
 529 %*                                                      *
 530 %*********************************************************
 531
 532 \begin{code}
 533 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
 534
 535 rnFds doc fds
 536   = mapRn rn_fds fds
 537   where
 538     rn_fds (tys1, tys2)
 539       = rnHsTyVars doc tys1             `thenRn` \ tys1' ->
 540         rnHsTyVars doc tys2             `thenRn` \ tys2' ->
 541         returnRn (tys1', tys2')
 542
 543 rnHsTyVars doc tvs  = mapRn (rnHsTyvar doc) tvs
 544 rnHsTyvar doc tyvar = lookupOccRn tyvar
 545 \end{code}
 546
 547 %*********************************************************
 548 %*                                                       *
 549 \subsection{IdInfo}
 550 %*                                                       *
 551 %*********************************************************
 552
 553 \begin{code}
 554 rnIdInfo (HsWorker worker arity)
 555   = lookupOccRn worker                  `thenRn` \ worker' ->
 556     returnRn (HsWorker worker' arity)
 557
 558 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
 559                                   returnRn (HsUnfold inline expr')
 560 rnIdInfo (HsStrictness str)     = returnRn (HsStrictness str)
 561 rnIdInfo (HsArity arity)        = returnRn (HsArity arity)
 562 rnIdInfo HsNoCafRefs            = returnRn HsNoCafRefs
 563 \end{code}
 564
 565 @UfCore@ expressions.
 566
 567 \begin{code}
 568 rnCoreExpr (UfType ty)
 569   = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
 570     returnRn (UfType ty')
 571
 572 rnCoreExpr (UfVar v)
 573   = lookupOccRn v       `thenRn` \ v' ->
 574     returnRn (UfVar v')
 575
 576 rnCoreExpr (UfLit l)
 577   = returnRn (UfLit l)
 578
 579 rnCoreExpr (UfLitLit l ty)
 580   = rnHsType (text "litlit") ty `thenRn` \ ty' ->
 581     returnRn (UfLitLit l ty')
 582
 583 rnCoreExpr (UfFCall cc ty)
 584   = rnHsType (text "ccall") ty  `thenRn` \ ty' ->
 585     returnRn (UfFCall cc ty')
 586
 587 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
 588   = mapRn rnCoreExpr args               `thenRn` \ args' ->
 589     returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
 590   where
 591     tup_name = getName (dataConId (tupleCon boxity arity))
 592         -- Get the *worker* name and use that
 593
 594 rnCoreExpr (UfApp fun arg)
 595   = rnCoreExpr fun              `thenRn` \ fun' ->
 596     rnCoreExpr arg              `thenRn` \ arg' ->
 597     returnRn (UfApp fun' arg')
 598
 599 rnCoreExpr (UfCase scrut bndr alts)
 600   = rnCoreExpr scrut                    `thenRn` \ scrut' ->
 601     bindCoreLocalRn bndr                $ \ bndr' ->
 602     mapRn rnCoreAlt alts                `thenRn` \ alts' ->
 603     returnRn (UfCase scrut' bndr' alts')
 604
 605 rnCoreExpr (UfNote note expr)
 606   = rnNote note                 `thenRn` \ note' ->
 607     rnCoreExpr expr             `thenRn` \ expr' ->
 608     returnRn  (UfNote note' expr')
 609
 610 rnCoreExpr (UfLam bndr body)
 611   = rnCoreBndr bndr             $ \ bndr' ->
 612     rnCoreExpr body             `thenRn` \ body' ->
 613     returnRn (UfLam bndr' body')
 614
 615 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
 616   = rnCoreExpr rhs              `thenRn` \ rhs' ->
 617     rnCoreBndr bndr             $ \ bndr' ->
 618     rnCoreExpr body             `thenRn` \ body' ->
 619     returnRn (UfLet (UfNonRec bndr' rhs') body')
 620
 621 rnCoreExpr (UfLet (UfRec pairs) body)
 622   = rnCoreBndrs bndrs           $ \ bndrs' ->
 623     mapRn rnCoreExpr rhss       `thenRn` \ rhss' ->
 624     rnCoreExpr body             `thenRn` \ body' ->
 625     returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
 626   where
 627     (bndrs, rhss) = unzip pairs
 628 \end{code}
 629
 630 \begin{code}
 631 rnCoreBndr (UfValBinder name ty) thing_inside
 632   = rnHsType doc ty             `thenRn` \ ty' ->
 633     bindCoreLocalRn name        $ \ name' ->
 634     thing_inside (UfValBinder name' ty')
 635   where
 636     doc = text "unfolding id"
 637
 638 rnCoreBndr (UfTyBinder name kind) thing_inside
 639   = bindCoreLocalRn name                $ \ name' ->
 640     thing_inside (UfTyBinder name' kind)
 641
 642 rnCoreBndrs []     thing_inside = thing_inside []
 643 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b          $ \ name' ->
 644                                   rnCoreBndrs bs        $ \ names' ->
 645                                   thing_inside (name':names')
 646 \end{code}
 647
 648 \begin{code}
 649 rnCoreAlt (con, bndrs, rhs)
 650   = rnUfCon con                         `thenRn` \ con' ->
 651     bindCoreLocalsRn bndrs              $ \ bndrs' ->
 652     rnCoreExpr rhs                      `thenRn` \ rhs' ->
 653     returnRn (con', bndrs', rhs')
 654
 655 rnNote (UfCoerce ty)
 656   = rnHsType (text "unfolding coerce") ty       `thenRn` \ ty' ->
 657     returnRn (UfCoerce ty')
 658
 659 rnNote (UfSCC cc)   = returnRn (UfSCC cc)
 660 rnNote UfInlineCall = returnRn UfInlineCall
 661 rnNote UfInlineMe   = returnRn UfInlineMe
 662
 663
 664 rnUfCon UfDefault
 665   = returnRn UfDefault
 666
 667 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
 668   = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
 669   where
 670     tup_name = getName (tupleCon boxity arity)
 671
 672 rnUfCon (UfDataAlt con)
 673   = lookupOccRn con             `thenRn` \ con' ->
 674     returnRn (UfDataAlt con')
 675
 676 rnUfCon (UfLitAlt lit)
 677   = returnRn (UfLitAlt lit)
 678
 679 rnUfCon (UfLitLitAlt lit ty)
 680   = rnHsType (text "litlit") ty         `thenRn` \ ty' ->
 681     returnRn (UfLitLitAlt lit ty')
 682 \end{code}
 683
 684 %*********************************************************
 685 %*                                                       *
 686 \subsection{Rule shapes}
 687 %*                                                       *
 688 %*********************************************************
 689
 690 Check the shape of a transformation rule LHS.  Currently
 691 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
 692 not one of the @forall@'d variables.
 693
 694 \begin{code}
 695 validRuleLhs foralls lhs
 696   = check lhs
 697   where
 698     check (OpApp _ op _ _)                = check op
 699     check (HsApp e1 e2)                   = check e1
 700     check (HsVar v) | v `notElem` foralls = True
 701     check other                           = False
 702 \end{code}
 703
 704
 705 %*********************************************************
 706 %*                                                       *
 707 \subsection{Errors}
 708 %*                                                       *
 709 %*********************************************************
 710
 711 \begin{code}
 712 badDataCon name
 713    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 714
 715 badRuleLhsErr name lhs
 716   = sep [ptext SLIT("Rule") <+> ptext name <> colon,
 717          nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
 718     $$
 719     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
 720
 721 badRuleVar name var
 722   = sep [ptext SLIT("Rule") <+> doubleQuotes (ptext name) <> colon,
 723          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
 724                 ptext SLIT("does not appear on left hand side")]
 725
 726 emptyConDeclsErr tycon
 727   = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
 728          nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
 729 \end{code}