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