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