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