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