ghc/compiler/rename/RnSource.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[RnSource]{Main pass of renamer}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module RnSource ( rnDecl, rnHsType ) where
  10
  11 IMP_Ubiq()
  12 IMPORT_DELOOPER(RnLoop)         -- *check* the RnPass/RnExpr/RnBinds loop-breaking
  13
  14 import HsSyn
  15 import HsDecls          ( HsIdInfo(..) )
  16 import HsPragmas
  17 import HsTypes          ( getTyVarName )
  18 import RdrHsSyn
  19 import RnHsSyn
  20 import HsCore
  21 import CmdLineOpts      ( opt_IgnoreIfacePragmas )
  22
  23 import RnBinds          ( rnTopBinds, rnMethodBinds )
  24 import RnEnv            ( bindTyVarsRn, lookupBndrRn, lookupOccRn, lookupImplicitOccRn, bindLocalsRn,
  25                           lookupOptionalOccRn, newSysName, newDfunName,
  26                           listType_RDR, tupleType_RDR )
  27 import RnMonad
  28
  29 import Name             ( Name, isLocallyDefined,
  30                           OccName(..), occNameString, prefixOccName,
  31                           ExportFlag(..),
  32                           Provenance,
  33                           SYN_IE(NameSet), unionNameSets, emptyNameSet, mkNameSet, unitNameSet,
  34                           elemNameSet
  35                         )
  36 import ErrUtils         ( addErrLoc, addShortErrLocLine, addShortWarnLocLine )
  37 import FiniteMap        ( emptyFM, lookupFM, addListToFM_C )
  38 import Id               ( GenId{-instance NamedThing-} )
  39 import IdInfo           ( IdInfo, StrictnessInfo(..), FBTypeInfo, DemandInfo, ArgUsageInfo )
  40 import SpecEnv          ( SpecEnv )
  41 import Lex              ( isLexCon )
  42 import CoreUnfold       ( Unfolding(..), SimpleUnfolding )
  43 import MagicUFs         ( MagicUnfoldingFun )
  44 import PrelInfo         ( derivingOccurrences, evalClass_RDR, numClass_RDR )
  45 import ListSetOps       ( unionLists, minusList )
  46 import Maybes           ( maybeToBool, catMaybes )
  47 import Bag              ( emptyBag, unitBag, consBag, unionManyBags, unionBags, listToBag, bagToList )
  48 import Outputable       ( Outputable(..){-instances-} )
  49 --import PprStyle       -- ToDo:rm
  50 import Pretty
  51 import SrcLoc           ( SrcLoc )
  52 -- import TyCon         ( TyCon{-instance NamedThing-} )
  53 import Unique           ( Unique )
  54 import UniqSet          ( SYN_IE(UniqSet) )
  55 import UniqFM           ( UniqFM, lookupUFM )
  56 import Util             ( isIn, isn'tIn, thenCmp, removeDups, cmpPString,
  57                           panic, assertPanic{- , pprTrace ToDo:rm-} )
  58 \end{code}
  59
  60 rnDecl `renames' declarations.
  61 It simultaneously performs dependency analysis and precedence parsing.
  62 It also does the following error checks:
  63 \begin{enumerate}
  64 \item
  65 Checks that tyvars are used properly. This includes checking
  66 for undefined tyvars, and tyvars in contexts that are ambiguous.
  67 \item
  68 Checks that all variable occurences are defined.
  69 \item
  70 Checks the (..) etc constraints in the export list.
  71 \end{enumerate}
  72
  73
  74 %*********************************************************
  75 %*                                                      *
  76 \subsection{Value declarations}
  77 %*                                                      *
  78 %*********************************************************
  79
  80 \begin{code}
  81 rnDecl :: RdrNameHsDecl -> RnMS s RenamedHsDecl
  82
  83 rnDecl (ValD binds) = rnTopBinds binds  `thenRn` \ new_binds ->
  84                       returnRn (ValD new_binds)
  85
  86
  87 rnDecl (SigD (IfaceSig name ty id_infos loc))
  88   = pushSrcLocRn loc $
  89     lookupBndrRn name           `thenRn` \ name' ->
  90     rnHsType ty                 `thenRn` \ ty' ->
  91
  92         -- Get the pragma info, unless we should ignore it
  93     (if opt_IgnoreIfacePragmas then
  94         returnRn []
  95      else
  96         mapRn rnIdInfo id_infos
  97     )                           `thenRn` \ id_infos' ->
  98
  99     returnRn (SigD (IfaceSig name' ty' id_infos' loc))
 100 \end{code}
 101
 102 %*********************************************************
 103 %*                                                      *
 104 \subsection{Type declarations}
 105 %*                                                      *
 106 %*********************************************************
 107
 108 @rnTyDecl@ uses the `global name function' to create a new type
 109 declaration in which local names have been replaced by their original
 110 names, reporting any unknown names.
 111
 112 Renaming type variables is a pain. Because they now contain uniques,
 113 it is necessary to pass in an association list which maps a parsed
 114 tyvar to its Name representation. In some cases (type signatures of
 115 values), it is even necessary to go over the type first in order to
 116 get the set of tyvars used by it, make an assoc list, and then go over
 117 it again to rename the tyvars! However, we can also do some scoping
 118 checks at the same time.
 119
 120 \begin{code}
 121 rnDecl (TyD (TyData context tycon tyvars condecls derivings pragmas src_loc))
 122   = pushSrcLocRn src_loc $
 123     lookupBndrRn tycon                          `thenRn` \ tycon' ->
 124     bindTyVarsRn "data declaration" tyvars      $ \ tyvars' ->
 125     rnContext context                           `thenRn` \ context' ->
 126     mapRn rnConDecl condecls                    `thenRn` \ condecls' ->
 127     rnDerivs derivings                          `thenRn` \ derivings' ->
 128     ASSERT(isNoDataPragmas pragmas)
 129     returnRn (TyD (TyData context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc))
 130
 131 rnDecl (TyD (TyNew context tycon tyvars condecl derivings pragmas src_loc))
 132   = pushSrcLocRn src_loc $
 133     lookupBndrRn tycon                          `thenRn` \ tycon' ->
 134     bindTyVarsRn "newtype declaration" tyvars   $ \ tyvars' ->
 135     rnContext context                           `thenRn` \ context' ->
 136     rnConDecl condecl                           `thenRn` \ condecl' ->
 137     rnDerivs derivings                          `thenRn` \ derivings' ->
 138     ASSERT(isNoDataPragmas pragmas)
 139     returnRn (TyD (TyNew context' tycon' tyvars' condecl' derivings' noDataPragmas src_loc))
 140
 141 rnDecl (TyD (TySynonym name tyvars ty src_loc))
 142   = pushSrcLocRn src_loc $
 143     lookupBndrRn name                           `thenRn` \ name' ->
 144     bindTyVarsRn "type declaration" tyvars      $ \ tyvars' ->
 145     rnHsType ty                                 `thenRn` \ ty' ->
 146     returnRn (TyD (TySynonym name' tyvars' ty' src_loc))
 147 \end{code}
 148
 149 %*********************************************************
 150 %*                                                      *
 151 \subsection{Class declarations}
 152 %*                                                      *
 153 %*********************************************************
 154
 155 @rnClassDecl@ uses the `global name function' to create a new
 156 class declaration in which local names have been replaced by their
 157 original names, reporting any unknown names.
 158
 159 \begin{code}
 160 rnDecl (ClD (ClassDecl context cname tyvar sigs mbinds pragmas src_loc))
 161   = pushSrcLocRn src_loc $
 162     bindTyVarsRn "class declaration" [tyvar]            $ \ [tyvar'] ->
 163     rnContext context                                   `thenRn` \ context' ->
 164     lookupBndrRn cname                                  `thenRn` \ cname' ->
 165     mapRn (rn_op cname' (getTyVarName tyvar')) sigs     `thenRn` \ sigs' ->
 166     rnMethodBinds mbinds                                `thenRn` \ mbinds' ->
 167     ASSERT(isNoClassPragmas pragmas)
 168     returnRn (ClD (ClassDecl context' cname' tyvar' sigs' mbinds' NoClassPragmas src_loc))
 169   where
 170     rn_op clas clas_tyvar sig@(ClassOpSig op _ ty locn)
 171       = pushSrcLocRn locn $
 172         let
 173                 dm_occ = prefixOccName SLIT("$m") (rdrNameOcc op)
 174         in
 175         lookupBndrRn op                         `thenRn` \ op_name ->
 176         newSysName dm_occ Exported locn         `thenRn` \ dm_name ->
 177         addOccurrenceName Optional dm_name      `thenRn_`
 178                 -- Call up interface info for default method, if such info exists
 179
 180         rnHsType ty                     `thenRn` \ new_ty  ->
 181         let
 182             (ctxt, op_ty) = case new_ty of
 183                                 HsForAllTy tvs ctxt op_ty -> (ctxt, op_ty)
 184                                 other                     -> ([], new_ty)
 185             ctxt_fvs  = extractCtxtTyNames ctxt
 186             op_ty_fvs = extractHsTyNames op_ty          -- Includes tycons/classes but we
 187                                                         -- don't care about that
 188         in
 189         -- check that class tyvar appears in op_ty
 190         checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
 191                 (classTyVarNotInOpTyErr clas_tyvar sig)
 192                                                          `thenRn_`
 193
 194         -- check that class tyvar *doesn't* appear in the sig's context
 195         checkRn (not (clas_tyvar `elemNameSet` ctxt_fvs))
 196                 (classTyVarInOpCtxtErr clas_tyvar sig)
 197                                                          `thenRn_`
 198
 199 --      ASSERT(isNoClassOpPragmas pragmas)
 200         returnRn (ClassOpSig op_name dm_name new_ty locn)
 201 \end{code}
 202
 203
 204 %*********************************************************
 205 %*                                                      *
 206 \subsection{Instance declarations}
 207 %*                                                      *
 208 %*********************************************************
 209
 210 \begin{code}
 211 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
 212   = pushSrcLocRn src_loc $
 213     rnHsType inst_ty                            `thenRn` \ inst_ty' ->
 214     rnMethodBinds mbinds                        `thenRn` \ mbinds' ->
 215     mapRn rn_uprag uprags                       `thenRn` \ new_uprags ->
 216
 217     newDfunName maybe_dfun src_loc              `thenRn` \ dfun_name ->
 218     addOccurrenceName Compulsory dfun_name      `thenRn_`
 219                         -- The dfun is not optional, because we use its version number
 220                         -- to identify the version of the instance declaration
 221
 222     returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc))
 223   where
 224     rn_uprag (SpecSig op ty using locn)
 225       = pushSrcLocRn src_loc $
 226         lookupBndrRn op                 `thenRn` \ op_name ->
 227         rnHsType ty                     `thenRn` \ new_ty ->
 228         rn_using using                  `thenRn` \ new_using ->
 229         returnRn (SpecSig op_name new_ty new_using locn)
 230
 231     rn_uprag (InlineSig op locn)
 232       = pushSrcLocRn locn $
 233         lookupBndrRn op                 `thenRn` \ op_name ->
 234         returnRn (InlineSig op_name locn)
 235
 236     rn_uprag (DeforestSig op locn)
 237       = pushSrcLocRn locn $
 238         lookupBndrRn op                 `thenRn` \ op_name ->
 239         returnRn (DeforestSig op_name locn)
 240
 241     rn_uprag (MagicUnfoldingSig op str locn)
 242       = pushSrcLocRn locn $
 243         lookupBndrRn op                 `thenRn` \ op_name ->
 244         returnRn (MagicUnfoldingSig op_name str locn)
 245
 246     rn_using Nothing  = returnRn Nothing
 247     rn_using (Just v) = lookupOccRn v   `thenRn` \ new_v ->
 248                         returnRn (Just new_v)
 249 \end{code}
 250
 251 %*********************************************************
 252 %*                                                      *
 253 \subsection{Default declarations}
 254 %*                                                      *
 255 %*********************************************************
 256
 257 \begin{code}
 258 rnDecl (DefD (DefaultDecl tys src_loc))
 259   = pushSrcLocRn src_loc $
 260     mapRn rnHsType tys                  `thenRn` \ tys' ->
 261     lookupImplicitOccRn numClass_RDR    `thenRn_`
 262     returnRn (DefD (DefaultDecl tys' src_loc))
 263 \end{code}
 264
 265 %*********************************************************
 266 %*                                                      *
 267 \subsection{Support code for type/data declarations}
 268 %*                                                      *
 269 %*********************************************************
 270
 271 \begin{code}
 272 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name])
 273
 274 rnDerivs Nothing -- derivs not specified
 275   = lookupImplicitOccRn evalClass_RDR           `thenRn_`
 276     returnRn Nothing
 277
 278 rnDerivs (Just ds)
 279   = lookupImplicitOccRn evalClass_RDR           `thenRn_`
 280     mapRn rn_deriv ds `thenRn` \ derivs ->
 281     returnRn (Just derivs)
 282   where
 283     rn_deriv clas
 284       = lookupOccRn clas            `thenRn` \ clas_name ->
 285
 286                 -- Now add extra "occurrences" for things that
 287                 -- the deriving mechanism will later need in order to
 288                 -- generate code for this class.
 289         case lookupUFM derivingOccurrences clas_name of
 290                 Nothing -> addErrRn (derivingNonStdClassErr clas_name)  `thenRn_`
 291                            returnRn clas_name
 292
 293                 Just occs -> mapRn lookupImplicitOccRn occs     `thenRn_`
 294                              returnRn clas_name
 295 \end{code}
 296
 297 \begin{code}
 298 rnConDecl :: RdrNameConDecl -> RnMS s RenamedConDecl
 299
 300 rnConDecl (ConDecl name tys src_loc)
 301   = pushSrcLocRn src_loc $
 302     checkConName name           `thenRn_`
 303     lookupBndrRn name           `thenRn` \ new_name ->
 304     mapRn rnBangTy tys          `thenRn` \ new_tys  ->
 305     returnRn (ConDecl new_name new_tys src_loc)
 306
 307 rnConDecl (ConOpDecl ty1 op ty2 src_loc)
 308   = pushSrcLocRn src_loc $
 309     lookupBndrRn op                     `thenRn` \ new_op  ->
 310     rnBangTy ty1                `thenRn` \ new_ty1 ->
 311     rnBangTy ty2                `thenRn` \ new_ty2 ->
 312     returnRn (ConOpDecl new_ty1 new_op new_ty2 src_loc)
 313
 314 rnConDecl (NewConDecl name ty src_loc)
 315   = pushSrcLocRn src_loc $
 316     checkConName name           `thenRn_`
 317     lookupBndrRn name           `thenRn` \ new_name ->
 318     rnHsType ty                 `thenRn` \ new_ty  ->
 319     returnRn (NewConDecl new_name new_ty src_loc)
 320
 321 rnConDecl (RecConDecl name fields src_loc)
 322   = pushSrcLocRn src_loc $
 323     lookupBndrRn name           `thenRn` \ new_name ->
 324     mapRn rnField fields        `thenRn` \ new_fields ->
 325     returnRn (RecConDecl new_name new_fields src_loc)
 326
 327 rnField (names, ty)
 328   = mapRn lookupBndrRn names    `thenRn` \ new_names ->
 329     rnBangTy ty                 `thenRn` \ new_ty ->
 330     returnRn (new_names, new_ty)
 331
 332 rnBangTy (Banged ty)
 333   = rnHsType ty `thenRn` \ new_ty ->
 334     returnRn (Banged new_ty)
 335
 336 rnBangTy (Unbanged ty)
 337   = rnHsType ty `thenRn` \ new_ty ->
 338     returnRn (Unbanged new_ty)
 339
 340 -- This data decl will parse OK
 341 --      data T = a Int
 342 -- treating "a" as the constructor.
 343 -- It is really hard to make the parser spot this malformation.
 344 -- So the renamer has to check that the constructor is legal
 345 --
 346 -- We can get an operator as the constructor, even in the prefix form:
 347 --      data T = :% Int Int
 348 -- from interface files, which always print in prefix form
 349
 350 checkConName name
 351   = checkRn (isLexCon (occNameString (rdrNameOcc name)))
 352             (badDataCon name)
 353 \end{code}
 354
 355
 356 %*********************************************************
 357 %*                                                      *
 358 \subsection{Support code to rename types}
 359 %*                                                      *
 360 %*********************************************************
 361
 362 \begin{code}
 363 rnHsType :: RdrNameHsType -> RnMS s RenamedHsType
 364
 365 rnHsType (HsForAllTy tvs ctxt ty)
 366   = rn_poly_help tvs ctxt ty
 367
 368 rnHsType full_ty@(HsPreForAllTy ctxt ty)
 369   = getNameEnv          `thenRn` \ name_env ->
 370     let
 371         mentioned_tyvars = extractHsTyVars full_ty
 372         forall_tyvars    = filter not_in_scope mentioned_tyvars
 373         not_in_scope tv  = case lookupFM name_env tv of
 374                                     Nothing -> True
 375                                     Just _  -> False
 376     in
 377     rn_poly_help (map UserTyVar forall_tyvars) ctxt ty
 378
 379 rnHsType (MonoTyVar tyvar)
 380   = lookupOccRn tyvar           `thenRn` \ tyvar' ->
 381     returnRn (MonoTyVar tyvar')
 382
 383 rnHsType (MonoFunTy ty1 ty2)
 384   = andRn MonoFunTy (rnHsType ty1) (rnHsType ty2)
 385
 386 rnHsType (MonoListTy _ ty)
 387   = lookupImplicitOccRn listType_RDR            `thenRn` \ tycon_name ->
 388     rnHsType ty                                 `thenRn` \ ty' ->
 389     returnRn (MonoListTy tycon_name ty')
 390
 391 rnHsType (MonoTupleTy _ tys)
 392   = lookupImplicitOccRn (tupleType_RDR (length tys))    `thenRn` \ tycon_name ->
 393     mapRn rnHsType tys                                  `thenRn` \ tys' ->
 394     returnRn (MonoTupleTy tycon_name tys')
 395
 396 rnHsType (MonoTyApp ty1 ty2)
 397   = rnHsType ty1                `thenRn` \ ty1' ->
 398     rnHsType ty2                `thenRn` \ ty2' ->
 399     returnRn (MonoTyApp ty1' ty2')
 400
 401 rnHsType (MonoDictTy clas ty)
 402   = lookupOccRn clas            `thenRn` \ clas' ->
 403     rnHsType ty                 `thenRn` \ ty' ->
 404     returnRn (MonoDictTy clas' ty')
 405
 406
 407 rn_poly_help :: [HsTyVar RdrName]               -- Universally quantified tyvars
 408              -> RdrNameContext
 409              -> RdrNameHsType
 410              -> RnMS s RenamedHsType
 411
 412 rn_poly_help tyvars ctxt ty
 413   = bindTyVarsRn "type signature" tyvars                $ \ new_tyvars ->
 414     rnContext ctxt                                      `thenRn` \ new_ctxt ->
 415     rnHsType ty                                         `thenRn` \ new_ty ->
 416     returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
 417 \end{code}
 418
 419
 420 \begin{code}
 421 rnContext :: RdrNameContext -> RnMS s RenamedContext
 422
 423 rnContext  ctxt
 424   = mapRn rn_ctxt ctxt  `thenRn` \ result ->
 425     let
 426         (_, dup_asserts) = removeDups cmp_assert result
 427     in
 428     -- If this isn't an error, then it ought to be:
 429     mapRn (addWarnRn . dupClassAssertWarn result) dup_asserts `thenRn_`
 430     returnRn result
 431   where
 432     rn_ctxt (clas, ty)
 433       = lookupOccRn clas        `thenRn` \ clas_name ->
 434         rnHsType ty             `thenRn` \ ty' ->
 435         returnRn (clas_name, ty')
 436
 437     cmp_assert (c1,ty1) (c2,ty2)
 438       = (c1 `cmp` c2) `thenCmp` (cmpHsType cmp ty1 ty2)
 439 \end{code}
 440
 441
 442 %*********************************************************
 443 %*                                                      *
 444 \subsection{IdInfo}
 445 %*                                                      *
 446 %*********************************************************
 447
 448 \begin{code}
 449 rnIdInfo (HsStrictness strict)
 450   = rnStrict strict     `thenRn` \ strict' ->
 451     returnRn (HsStrictness strict')
 452
 453 rnIdInfo (HsUnfold expr)        = rnCoreExpr expr       `thenRn` \ expr' ->
 454                                   returnRn (HsUnfold expr')
 455 rnIdInfo (HsArity arity)        = returnRn (HsArity arity)
 456 rnIdInfo (HsUpdate update)      = returnRn (HsUpdate update)
 457 rnIdInfo (HsFBType fb)          = returnRn (HsFBType fb)
 458 rnIdInfo (HsArgUsage au)        = returnRn (HsArgUsage au)
 459 rnIdInfo (HsDeforest df)        = returnRn (HsDeforest df)
 460
 461 rnStrict (StrictnessInfo demands (Just worker))
 462   = lookupOptionalOccRn worker          `thenRn` \ worker' ->
 463     returnRn (StrictnessInfo demands (Just worker'))
 464
 465 -- Boring, but necessary for the type checker.
 466 rnStrict (StrictnessInfo demands Nothing) = returnRn (StrictnessInfo demands Nothing)
 467 rnStrict BottomGuaranteed                 = returnRn BottomGuaranteed
 468 rnStrict NoStrictnessInfo                 = returnRn NoStrictnessInfo
 469 \end{code}
 470
 471 UfCore expressions.
 472
 473 \begin{code}
 474 rnCoreExpr (UfVar v)
 475   = lookupOptionalOccRn v       `thenRn` \ v' ->
 476     returnRn (UfVar v')
 477
 478 rnCoreExpr (UfLit lit) = returnRn (UfLit lit)
 479
 480 rnCoreExpr (UfCon con args)
 481   = lookupOptionalOccRn con             `thenRn` \ con' ->
 482     mapRn rnCoreArg args        `thenRn` \ args' ->
 483     returnRn (UfCon con' args')
 484
 485 rnCoreExpr (UfPrim prim args)
 486   = rnCorePrim prim             `thenRn` \ prim' ->
 487     mapRn rnCoreArg args        `thenRn` \ args' ->
 488     returnRn (UfPrim prim' args')
 489
 490 rnCoreExpr (UfApp fun arg)
 491   = rnCoreExpr fun              `thenRn` \ fun' ->
 492     rnCoreArg arg               `thenRn` \ arg' ->
 493     returnRn (UfApp fun' arg')
 494
 495 rnCoreExpr (UfCase scrut alts)
 496   = rnCoreExpr scrut            `thenRn` \ scrut' ->
 497     rnCoreAlts alts             `thenRn` \ alts' ->
 498     returnRn (UfCase scrut' alts')
 499
 500 rnCoreExpr (UfSCC cc expr)
 501   = rnCoreExpr expr             `thenRn` \ expr' ->
 502     returnRn  (UfSCC cc expr')
 503
 504 rnCoreExpr(UfCoerce coercion ty body)
 505   = rnCoercion coercion         `thenRn` \ coercion' ->
 506     rnHsType ty                 `thenRn` \ ty' ->
 507     rnCoreExpr body             `thenRn` \ body' ->
 508     returnRn (UfCoerce coercion' ty' body')
 509
 510 rnCoreExpr (UfLam bndr body)
 511   = rnCoreBndr bndr             $ \ bndr' ->
 512     rnCoreExpr body             `thenRn` \ body' ->
 513     returnRn (UfLam bndr' body')
 514
 515 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
 516   = rnCoreExpr rhs              `thenRn` \ rhs' ->
 517     rnCoreBndr bndr             $ \ bndr' ->
 518     rnCoreExpr body             `thenRn` \ body' ->
 519     returnRn (UfLet (UfNonRec bndr' rhs') body')
 520
 521 rnCoreExpr (UfLet (UfRec pairs) body)
 522   = rnCoreBndrs bndrs           $ \ bndrs' ->
 523     mapRn rnCoreExpr rhss       `thenRn` \ rhss' ->
 524     rnCoreExpr body             `thenRn` \ body' ->
 525     returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
 526   where
 527     (bndrs, rhss) = unzip pairs
 528 \end{code}
 529
 530 \begin{code}
 531 rnCoreBndr (UfValBinder name ty) thing_inside
 532   = rnHsType ty                 `thenRn` \ ty' ->
 533     bindLocalsRn "unfolding value" [name] $ \ [name'] ->
 534     thing_inside (UfValBinder name' ty')
 535
 536 rnCoreBndr (UfTyBinder name kind) thing_inside
 537   = bindLocalsRn "unfolding tyvar" [name] $ \ [name'] ->
 538     thing_inside (UfTyBinder name' kind)
 539
 540 rnCoreBndr (UfUsageBinder name) thing_inside
 541   = bindLocalsRn "unfolding usage" [name] $ \ [name'] ->
 542     thing_inside (UfUsageBinder name')
 543
 544 rnCoreBndrs bndrs thing_inside          -- Expect them all to be ValBinders
 545   = mapRn rnHsType tys                  `thenRn` \ tys' ->
 546     bindLocalsRn "unfolding value" names $ \ names' ->
 547     thing_inside (zipWith UfValBinder names' tys')
 548   where
 549     names = map (\ (UfValBinder name _) -> name) bndrs
 550     tys   = map (\ (UfValBinder _   ty) -> ty)   bndrs
 551
 552 rnCoreBndrNamess names thing_inside
 553   = bindLocalsRn "unfolding value" names $ \ names' ->
 554     thing_inside names'
 555 \end{code}
 556
 557 \begin{code}
 558 rnCoreArg (UfVarArg v)   = lookupOptionalOccRn v        `thenRn` \ v' -> returnRn (UfVarArg v')
 559 rnCoreArg (UfUsageArg u) = lookupOptionalOccRn u        `thenRn` \ u' -> returnRn (UfUsageArg u')
 560 rnCoreArg (UfTyArg ty)   = rnHsType ty                  `thenRn` \ ty' -> returnRn (UfTyArg ty')
 561 rnCoreArg (UfLitArg lit) = returnRn (UfLitArg lit)
 562
 563 rnCoreAlts (UfAlgAlts alts deflt)
 564   = mapRn rn_alt alts           `thenRn` \ alts' ->
 565     rnCoreDefault deflt         `thenRn` \ deflt' ->
 566     returnRn (UfAlgAlts alts' deflt')
 567   where
 568     rn_alt (con, bndrs, rhs) =  lookupOptionalOccRn con                 `thenRn` \ con' ->
 569                                 bindLocalsRn "unfolding alt" bndrs      $ \ bndrs' ->
 570                                 rnCoreExpr rhs                          `thenRn` \ rhs' ->
 571                                 returnRn (con', bndrs', rhs')
 572
 573 rnCoreAlts (UfPrimAlts alts deflt)
 574   = mapRn rn_alt alts           `thenRn` \ alts' ->
 575     rnCoreDefault deflt         `thenRn` \ deflt' ->
 576     returnRn (UfPrimAlts alts' deflt')
 577   where
 578     rn_alt (lit, rhs) = rnCoreExpr rhs          `thenRn` \ rhs' ->
 579                         returnRn (lit, rhs')
 580
 581 rnCoreDefault UfNoDefault = returnRn UfNoDefault
 582 rnCoreDefault (UfBindDefault bndr rhs) = bindLocalsRn "unfolding default" [bndr]        $ \ [bndr'] ->
 583                                          rnCoreExpr rhs                                 `thenRn` \ rhs' ->
 584                                          returnRn (UfBindDefault bndr' rhs')
 585
 586 rnCoercion (UfIn  n) = lookupOptionalOccRn n `thenRn` \ n' -> returnRn (UfIn  n')
 587 rnCoercion (UfOut n) = lookupOptionalOccRn n `thenRn` \ n' -> returnRn (UfOut n')
 588
 589 rnCorePrim (UfOtherOp op)
 590   = lookupOptionalOccRn op      `thenRn` \ op' ->
 591     returnRn (UfOtherOp op')
 592
 593 rnCorePrim (UfCCallOp str casm gc arg_tys res_ty)
 594   = mapRn rnHsType arg_tys      `thenRn` \ arg_tys' ->
 595     rnHsType res_ty             `thenRn` \ res_ty' ->
 596     returnRn (UfCCallOp str casm gc arg_tys' res_ty')
 597 \end{code}
 598
 599 %*********************************************************
 600 %*                                                      *
 601 \subsection{Errors}
 602 %*                                                      *
 603 %*********************************************************
 604
 605 \begin{code}
 606 derivingNonStdClassErr clas sty
 607   = ppCat [ppPStr SLIT("non-standard class in deriving:"), ppr sty clas]
 608
 609 classTyVarNotInOpTyErr clas_tyvar sig sty
 610   = ppHang (ppBesides [ppPStr SLIT("Class type variable `"),
 611                        ppr sty clas_tyvar,
 612                        ppPStr SLIT("' does not appear in method signature:")])
 613          4 (ppr sty sig)
 614
 615 classTyVarInOpCtxtErr clas_tyvar sig sty
 616   = ppHang (ppBesides [ ppPStr SLIT("Class type variable `"), ppr sty clas_tyvar,
 617                         ppPStr SLIT("' present in method's local overloading context:")])
 618          4 (ppr sty sig)
 619
 620 dupClassAssertWarn ctxt dups sty
 621   = ppHang (ppBesides [ppPStr SLIT("Duplicate class assertion `"),
 622                        ppr sty dups,
 623                        ppPStr SLIT("' in context:")])
 624          4 (ppr sty ctxt)
 625
 626 badDataCon name sty
 627    = ppCat [ppPStr SLIT("Illegal data constructor name:"), ppr sty name]
 628 \end{code}
 629
 630
 631
 632
 633
 634 ===================     OLD STUFF    ======================
 635
 636 %*********************************************************
 637 %*                                                       *
 638 \subsection{SPECIALIZE data pragmas}
 639 %*                                                       *
 640 %*********************************************************
 641
 642 \begin{pseudocode}
 643 rnSpecDataSig :: RdrNameSpecDataSig
 644               -> RnMS s RenamedSpecDataSig
 645
 646 rnSpecDataSig (SpecDataSig tycon ty src_loc)
 647   = pushSrcLocRn src_loc $
 648     let
 649         tyvars = filter extractHsTyNames ty
 650     in
 651     mkTyVarNamesEnv src_loc tyvars      `thenRn` \ (tv_env,_) ->
 652     lookupOccRn tycon                   `thenRn` \ tycon' ->
 653     rnHsType tv_env ty          `thenRn` \ ty' ->
 654     returnRn (SpecDataSig tycon' ty' src_loc)
 655
 656 \end{pseudocode}
 657
 658 %*********************************************************
 659 %*                                                      *
 660 \subsection{@SPECIALIZE instance@ user-pragmas}
 661 %*                                                      *
 662 %*********************************************************
 663
 664 \begin{pseudocode}
 665 rnSpecInstSig :: RdrNameSpecInstSig
 666               -> RnMS s RenamedSpecInstSig
 667
 668 rnSpecInstSig (SpecInstSig clas ty src_loc)
 669   = pushSrcLocRn src_loc $
 670     let
 671         tyvars = extractHsTyNames is_tyvar_name ty
 672     in
 673     mkTyVarNamesEnv src_loc tyvars      `thenRn` \ (tv_env,_) ->
 674     lookupOccRn clas                    `thenRn` \ new_clas ->
 675     rnHsType tv_env ty          `thenRn` \ new_ty ->
 676     returnRn (SpecInstSig new_clas new_ty src_loc)
 677 \end{pseudocode}