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