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