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