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     {-      ( isIn, isn'tIn, thenCmp, removeDups, cmpPString,
  61                           panic, assertPanic{- , pprTrace ToDo:rm-} ) -}
  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                 -- Check that class tyvar *doesn't* appear in the sig's context
 217         checkRn (not (clas_tyvar `elemNameSet` ctxt_fvs))
 218                 (classTyVarInOpCtxtErr clas_tyvar sig)
 219                                                          `thenRn_`
 220
 221         returnRn (ClassOpSig op_name dm_name new_ty locn)
 222 \end{code}
 223
 224
 225 %*********************************************************
 226 %*                                                      *
 227 \subsection{Instance declarations}
 228 %*                                                      *
 229 %*********************************************************
 230
 231 \begin{code}
 232 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
 233   = pushSrcLocRn src_loc $
 234     rnHsSigType (\sty -> text "an instance decl") inst_ty       `thenRn` \ inst_ty' ->
 235
 236
 237         -- Rename the bindings
 238         -- NB meth_names can be qualified!
 239     checkDupNames meth_doc meth_names           `thenRn_`
 240     rnMethodBinds mbinds                        `thenRn` \ mbinds' ->
 241     mapRn rn_uprag uprags                       `thenRn` \ new_uprags ->
 242
 243     newDfunName maybe_dfun src_loc              `thenRn` \ dfun_name ->
 244     addOccurrenceName dfun_name                 `thenRn_`
 245                         -- The dfun is not optional, because we use its version number
 246                         -- to identify the version of the instance declaration
 247
 248         -- The typechecker checks that all the bindings are for the right class.
 249     returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc))
 250   where
 251     meth_doc sty = text "the bindings in an instance declaration"
 252     meth_names   = bagToList (collectMonoBinders mbinds)
 253
 254     rn_uprag (SpecSig op ty using locn)
 255       = pushSrcLocRn src_loc $
 256         lookupBndrRn op                         `thenRn` \ op_name ->
 257         rnHsSigType (\sty -> ppr sty op) ty     `thenRn` \ new_ty ->
 258         rn_using using                          `thenRn` \ new_using ->
 259         returnRn (SpecSig op_name new_ty new_using locn)
 260
 261     rn_uprag (InlineSig op locn)
 262       = pushSrcLocRn locn $
 263         lookupBndrRn op                 `thenRn` \ op_name ->
 264         returnRn (InlineSig op_name locn)
 265
 266     rn_uprag (DeforestSig op locn)
 267       = pushSrcLocRn locn $
 268         lookupBndrRn op                 `thenRn` \ op_name ->
 269         returnRn (DeforestSig op_name locn)
 270
 271     rn_uprag (MagicUnfoldingSig op str locn)
 272       = pushSrcLocRn locn $
 273         lookupBndrRn op                 `thenRn` \ op_name ->
 274         returnRn (MagicUnfoldingSig op_name str locn)
 275
 276     rn_using Nothing  = returnRn Nothing
 277     rn_using (Just v) = lookupOccRn v   `thenRn` \ new_v ->
 278                         returnRn (Just new_v)
 279 \end{code}
 280
 281 %*********************************************************
 282 %*                                                      *
 283 \subsection{Default declarations}
 284 %*                                                      *
 285 %*********************************************************
 286
 287 \begin{code}
 288 rnDecl (DefD (DefaultDecl tys src_loc))
 289   = pushSrcLocRn src_loc $
 290     mapRn rnHsType tys                  `thenRn` \ tys' ->
 291     lookupImplicitOccRn numClass_RDR    `thenRn_`
 292     returnRn (DefD (DefaultDecl tys' src_loc))
 293 \end{code}
 294
 295 %*********************************************************
 296 %*                                                      *
 297 \subsection{Support code for type/data declarations}
 298 %*                                                      *
 299 %*********************************************************
 300
 301 \begin{code}
 302 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name])
 303
 304 rnDerivs Nothing -- derivs not specified
 305   = lookupImplicitOccRn evalClass_RDR           `thenRn_`
 306     returnRn Nothing
 307
 308 rnDerivs (Just ds)
 309   = lookupImplicitOccRn evalClass_RDR           `thenRn_`
 310     mapRn rn_deriv ds `thenRn` \ derivs ->
 311     returnRn (Just derivs)
 312   where
 313     rn_deriv clas
 314       = lookupOccRn clas            `thenRn` \ clas_name ->
 315
 316                 -- Now add extra "occurrences" for things that
 317                 -- the deriving mechanism will later need in order to
 318                 -- generate code for this class.
 319         case lookupUFM derivingOccurrences clas_name of
 320                 Nothing -> addErrRn (derivingNonStdClassErr clas_name)  `thenRn_`
 321                            returnRn clas_name
 322
 323                 Just occs -> mapRn lookupImplicitOccRn occs     `thenRn_`
 324                              returnRn clas_name
 325 \end{code}
 326
 327 \begin{code}
 328 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
 329 conDeclName (ConDecl n _ _ l)     = (n,l)
 330
 331 rnConDecl :: RdrNameConDecl -> RnMS s RenamedConDecl
 332 rnConDecl (ConDecl name cxt details locn)
 333   = pushSrcLocRn locn $
 334     checkConName name                   `thenRn_`
 335     lookupBndrRn name                   `thenRn` \ new_name ->
 336     rnConDetails name locn details      `thenRn` \ new_details ->
 337     rnContext cxt                       `thenRn` \ new_context ->
 338     returnRn (ConDecl new_name new_context new_details locn)
 339
 340 rnConDetails con locn (VanillaCon tys)
 341   = mapRn rnBangTy tys          `thenRn` \ new_tys  ->
 342     returnRn (VanillaCon new_tys)
 343
 344 rnConDetails con locn (InfixCon ty1 ty2)
 345   = rnBangTy ty1                `thenRn` \ new_ty1 ->
 346     rnBangTy ty2                `thenRn` \ new_ty2 ->
 347     returnRn (InfixCon new_ty1 new_ty2)
 348
 349 rnConDetails con locn (NewCon ty)
 350   = rnHsType ty                 `thenRn` \ new_ty  ->
 351     returnRn (NewCon new_ty)
 352
 353 rnConDetails con locn (RecCon fields)
 354   = checkDupOrQualNames fld_doc field_names     `thenRn_`
 355     mapRn rnField fields                        `thenRn` \ new_fields ->
 356     returnRn (RecCon new_fields)
 357   where
 358     fld_doc sty = text "the fields of constructor" <> ppr sty con
 359     field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
 360
 361 rnField (names, ty)
 362   = mapRn lookupBndrRn names    `thenRn` \ new_names ->
 363     rnBangTy ty                 `thenRn` \ new_ty ->
 364     returnRn (new_names, new_ty)
 365
 366 rnBangTy (Banged ty)
 367   = rnHsType ty `thenRn` \ new_ty ->
 368     returnRn (Banged new_ty)
 369
 370 rnBangTy (Unbanged ty)
 371   = rnHsType ty `thenRn` \ new_ty ->
 372     returnRn (Unbanged new_ty)
 373
 374 -- This data decl will parse OK
 375 --      data T = a Int
 376 -- treating "a" as the constructor.
 377 -- It is really hard to make the parser spot this malformation.
 378 -- So the renamer has to check that the constructor is legal
 379 --
 380 -- We can get an operator as the constructor, even in the prefix form:
 381 --      data T = :% Int Int
 382 -- from interface files, which always print in prefix form
 383
 384 checkConName name
 385   = checkRn (isLexCon (occNameString (rdrNameOcc name)))
 386             (badDataCon name)
 387 \end{code}
 388
 389
 390 %*********************************************************
 391 %*                                                      *
 392 \subsection{Support code to rename types}
 393 %*                                                      *
 394 %*********************************************************
 395
 396 \begin{code}
 397 rnHsSigType :: (PprStyle -> Doc) -> RdrNameHsType -> RnMS s RenamedHsType
 398         -- rnHsSigType is used for source-language type signatures,
 399         -- which use *implicit* universal quantification.
 400
 401 rnHsSigType doc_str full_ty@(HsPreForAllTy ctxt ty)     -- From source code (no kinds on tyvars)
 402   = getNameEnv          `thenRn` \ name_env ->
 403     let
 404         mentioned_tyvars = extractHsTyVars full_ty
 405         forall_tyvars    = filter not_in_scope mentioned_tyvars
 406         not_in_scope tv  = case lookupFM name_env tv of
 407                                     Nothing -> True
 408                                     Just _  -> False
 409
 410         non_foralld_constrained = [tv | (clas, ty) <- ctxt,
 411                                         tv <- extractHsTyVars ty,
 412                                         not (tv `elem` forall_tyvars)
 413                                   ]
 414     in
 415     checkRn (null non_foralld_constrained)
 416             (ctxtErr sig_doc non_foralld_constrained)   `thenRn_`
 417
 418     (bindTyVarsRn sig_doc (map UserTyVar forall_tyvars) $ \ new_tyvars ->
 419      rnContext ctxt                                     `thenRn` \ new_ctxt ->
 420      rnHsType ty                                        `thenRn` \ new_ty ->
 421      returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
 422     )
 423   where
 424     sig_doc sty = text "the type signature for" <+> doc_str sty
 425
 426
 427 rnHsSigType doc_str other_ty = rnHsType other_ty
 428
 429 rnHsType :: RdrNameHsType -> RnMS s RenamedHsType
 430 rnHsType (HsForAllTy tvs ctxt ty)               -- From an interface file (tyvars may be kinded)
 431   = rn_poly_help tvs ctxt ty
 432
 433 rnHsType full_ty@(HsPreForAllTy ctxt ty)        -- A (context => ty) embedded in a type.
 434                                                 -- Universally quantify over tyvars in context
 435   = getNameEnv          `thenRn` \ name_env ->
 436     let
 437         forall_tyvars = foldr unionLists [] (map (extractHsTyVars . snd) ctxt)
 438     in
 439     rn_poly_help (map UserTyVar forall_tyvars) ctxt ty
 440
 441 rnHsType (MonoTyVar tyvar)
 442   = lookupOccRn tyvar           `thenRn` \ tyvar' ->
 443     returnRn (MonoTyVar tyvar')
 444
 445 rnHsType (MonoFunTy ty1 ty2)
 446   = andRn MonoFunTy (rnHsType ty1) (rnHsType ty2)
 447
 448 rnHsType (MonoListTy _ ty)
 449   = lookupImplicitOccRn listType_RDR            `thenRn` \ tycon_name ->
 450     rnHsType ty                                 `thenRn` \ ty' ->
 451     returnRn (MonoListTy tycon_name ty')
 452
 453 rnHsType (MonoTupleTy _ tys)
 454   = lookupImplicitOccRn (tupleType_RDR (length tys))    `thenRn` \ tycon_name ->
 455     mapRn rnHsType tys                                  `thenRn` \ tys' ->
 456     returnRn (MonoTupleTy tycon_name tys')
 457
 458 rnHsType (MonoTyApp ty1 ty2)
 459   = rnHsType ty1                `thenRn` \ ty1' ->
 460     rnHsType ty2                `thenRn` \ ty2' ->
 461     returnRn (MonoTyApp ty1' ty2')
 462
 463 rnHsType (MonoDictTy clas ty)
 464   = lookupOccRn clas            `thenRn` \ clas' ->
 465     rnHsType ty                 `thenRn` \ ty' ->
 466     returnRn (MonoDictTy clas' ty')
 467
 468 rn_poly_help :: [HsTyVar RdrName]               -- Universally quantified tyvars
 469              -> RdrNameContext
 470              -> RdrNameHsType
 471              -> RnMS s RenamedHsType
 472 rn_poly_help tyvars ctxt ty
 473   = bindTyVarsRn sig_doc tyvars                         $ \ new_tyvars ->
 474     rnContext ctxt                                      `thenRn` \ new_ctxt ->
 475     rnHsType ty                                         `thenRn` \ new_ty ->
 476     returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
 477   where
 478     sig_doc sty = text "a nested for-all type"
 479 \end{code}
 480
 481
 482 \begin{code}
 483 rnContext :: RdrNameContext -> RnMS s RenamedContext
 484
 485 rnContext  ctxt
 486   = mapRn rn_ctxt ctxt  `thenRn` \ result ->
 487     let
 488         (_, dup_asserts) = removeDups cmp_assert result
 489         (alls, theta)    = partition (\(c,_) -> c == allClass_NAME) result
 490         non_tyvar_alls   = [(c,t) | (c,t) <- alls, not (is_tyvar t)]
 491     in
 492
 493         -- Check for duplicate assertions
 494         -- If this isn't an error, then it ought to be:
 495     mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
 496
 497         -- Check for All constraining a non-type-variable
 498     mapRn (addWarnRn . allOfNonTyVar) non_tyvar_alls    `thenRn_`
 499
 500         -- Done.  Return a theta omitting all the "All" constraints.
 501         -- They have done done their work by ensuring that we universally
 502         -- quantify over their tyvar.
 503     returnRn theta
 504   where
 505     rn_ctxt (clas, ty)
 506       =         -- Mini hack here.  If the class is our pseudo-class "All",
 507                 -- then we don't want to record it as an occurrence, otherwise
 508                 -- we try to slurp it in later and it doesn't really exist at all.
 509                 -- Easiest thing is simply not to put it in the occurrence set.
 510         lookupBndrRn clas       `thenRn` \ clas_name ->
 511         (if clas_name /= allClass_NAME then
 512                 addOccurrenceName clas_name
 513          else
 514                 returnRn clas_name
 515         )                       `thenRn_`
 516         rnHsType ty             `thenRn` \ ty' ->
 517         returnRn (clas_name, ty')
 518
 519     cmp_assert (c1,ty1) (c2,ty2)
 520       = (c1 `cmp` c2) `thenCmp` (cmpHsType cmp ty1 ty2)
 521
 522     is_tyvar (MonoTyVar _) = True
 523     is_tyvar other         = False
 524 \end{code}
 525
 526
 527 %*********************************************************
 528 %*                                                      *
 529 \subsection{IdInfo}
 530 %*                                                      *
 531 %*********************************************************
 532
 533 \begin{code}
 534 rnIdInfo (HsStrictness strict)
 535   = rnStrict strict     `thenRn` \ strict' ->
 536     returnRn (HsStrictness strict')
 537
 538 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr       `thenRn` \ expr' ->
 539                                   returnRn (HsUnfold inline expr')
 540 rnIdInfo (HsArity arity)        = returnRn (HsArity arity)
 541 rnIdInfo (HsUpdate update)      = returnRn (HsUpdate update)
 542 rnIdInfo (HsFBType fb)          = returnRn (HsFBType fb)
 543 rnIdInfo (HsArgUsage au)        = returnRn (HsArgUsage au)
 544 rnIdInfo (HsDeforest df)        = returnRn (HsDeforest df)
 545
 546 rnStrict (StrictnessInfo demands (Just (worker,cons)))
 547         -- The sole purpose of the "cons" field is so that we can mark the constructors
 548         -- needed to build the wrapper as "needed", so that their data type decl will be
 549         -- slurped in. After that their usefulness is o'er, so we just put in the empty list.
 550   = lookupOccRn worker                  `thenRn` \ worker' ->
 551     mapRn lookupOccRn cons              `thenRn_`
 552     returnRn (StrictnessInfo demands (Just (worker',[])))
 553
 554 -- Boring, but necessary for the type checker.
 555 rnStrict (StrictnessInfo demands Nothing) = returnRn (StrictnessInfo demands Nothing)
 556 rnStrict BottomGuaranteed                 = returnRn BottomGuaranteed
 557 rnStrict NoStrictnessInfo                 = returnRn NoStrictnessInfo
 558 \end{code}
 559
 560 UfCore expressions.
 561
 562 \begin{code}
 563 rnCoreExpr (UfVar v)
 564   = lookupOccRn v       `thenRn` \ v' ->
 565     returnRn (UfVar v')
 566
 567 rnCoreExpr (UfLit lit) = returnRn (UfLit lit)
 568
 569 rnCoreExpr (UfCon con args)
 570   = lookupOccRn con             `thenRn` \ con' ->
 571     mapRn rnCoreArg args        `thenRn` \ args' ->
 572     returnRn (UfCon con' args')
 573
 574 rnCoreExpr (UfPrim prim args)
 575   = rnCorePrim prim             `thenRn` \ prim' ->
 576     mapRn rnCoreArg args        `thenRn` \ args' ->
 577     returnRn (UfPrim prim' args')
 578
 579 rnCoreExpr (UfApp fun arg)
 580   = rnCoreExpr fun              `thenRn` \ fun' ->
 581     rnCoreArg arg               `thenRn` \ arg' ->
 582     returnRn (UfApp fun' arg')
 583
 584 rnCoreExpr (UfCase scrut alts)
 585   = rnCoreExpr scrut            `thenRn` \ scrut' ->
 586     rnCoreAlts alts             `thenRn` \ alts' ->
 587     returnRn (UfCase scrut' alts')
 588
 589 rnCoreExpr (UfSCC cc expr)
 590   = rnCoreExpr expr             `thenRn` \ expr' ->
 591     returnRn  (UfSCC cc expr')
 592
 593 rnCoreExpr(UfCoerce coercion ty body)
 594   = rnCoercion coercion         `thenRn` \ coercion' ->
 595     rnHsType ty                 `thenRn` \ ty' ->
 596     rnCoreExpr body             `thenRn` \ body' ->
 597     returnRn (UfCoerce coercion' ty' body')
 598
 599 rnCoreExpr (UfLam bndr body)
 600   = rnCoreBndr bndr             $ \ bndr' ->
 601     rnCoreExpr body             `thenRn` \ body' ->
 602     returnRn (UfLam bndr' body')
 603
 604 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
 605   = rnCoreExpr rhs              `thenRn` \ rhs' ->
 606     rnCoreBndr bndr             $ \ bndr' ->
 607     rnCoreExpr body             `thenRn` \ body' ->
 608     returnRn (UfLet (UfNonRec bndr' rhs') body')
 609
 610 rnCoreExpr (UfLet (UfRec pairs) body)
 611   = rnCoreBndrs bndrs           $ \ bndrs' ->
 612     mapRn rnCoreExpr rhss       `thenRn` \ rhss' ->
 613     rnCoreExpr body             `thenRn` \ body' ->
 614     returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
 615   where
 616     (bndrs, rhss) = unzip pairs
 617 \end{code}
 618
 619 \begin{code}
 620 rnCoreBndr (UfValBinder name ty) thing_inside
 621   = rnHsType ty                 `thenRn` \ ty' ->
 622     bindLocalsRn "unfolding value" [name] $ \ [name'] ->
 623     thing_inside (UfValBinder name' ty')
 624
 625 rnCoreBndr (UfTyBinder name kind) thing_inside
 626   = bindLocalsRn "unfolding tyvar" [name] $ \ [name'] ->
 627     thing_inside (UfTyBinder name' kind)
 628
 629 rnCoreBndr (UfUsageBinder name) thing_inside
 630   = bindLocalsRn "unfolding usage" [name] $ \ [name'] ->
 631     thing_inside (UfUsageBinder name')
 632
 633 rnCoreBndrs bndrs thing_inside          -- Expect them all to be ValBinders
 634   = mapRn rnHsType tys                  `thenRn` \ tys' ->
 635     bindLocalsRn "unfolding value" names $ \ names' ->
 636     thing_inside (zipWith UfValBinder names' tys')
 637   where
 638     names = map (\ (UfValBinder name _) -> name) bndrs
 639     tys   = map (\ (UfValBinder _   ty) -> ty)   bndrs
 640
 641 rnCoreBndrNamess names thing_inside
 642   = bindLocalsRn "unfolding value" names $ \ names' ->
 643     thing_inside names'
 644 \end{code}
 645
 646 \begin{code}
 647 rnCoreArg (UfVarArg v)   = lookupOccRn v        `thenRn` \ v' -> returnRn (UfVarArg v')
 648 rnCoreArg (UfUsageArg u) = lookupOccRn u        `thenRn` \ u' -> returnRn (UfUsageArg u')
 649 rnCoreArg (UfTyArg ty)   = rnHsType ty                  `thenRn` \ ty' -> returnRn (UfTyArg ty')
 650 rnCoreArg (UfLitArg lit) = returnRn (UfLitArg lit)
 651
 652 rnCoreAlts (UfAlgAlts alts deflt)
 653   = mapRn rn_alt alts           `thenRn` \ alts' ->
 654     rnCoreDefault deflt         `thenRn` \ deflt' ->
 655     returnRn (UfAlgAlts alts' deflt')
 656   where
 657     rn_alt (con, bndrs, rhs) =  lookupOccRn con                 `thenRn` \ con' ->
 658                                 bindLocalsRn "unfolding alt" bndrs      $ \ bndrs' ->
 659                                 rnCoreExpr rhs                          `thenRn` \ rhs' ->
 660                                 returnRn (con', bndrs', rhs')
 661
 662 rnCoreAlts (UfPrimAlts alts deflt)
 663   = mapRn rn_alt alts           `thenRn` \ alts' ->
 664     rnCoreDefault deflt         `thenRn` \ deflt' ->
 665     returnRn (UfPrimAlts alts' deflt')
 666   where
 667     rn_alt (lit, rhs) = rnCoreExpr rhs          `thenRn` \ rhs' ->
 668                         returnRn (lit, rhs')
 669
 670 rnCoreDefault UfNoDefault = returnRn UfNoDefault
 671 rnCoreDefault (UfBindDefault bndr rhs) = bindLocalsRn "unfolding default" [bndr]        $ \ [bndr'] ->
 672                                          rnCoreExpr rhs                                 `thenRn` \ rhs' ->
 673                                          returnRn (UfBindDefault bndr' rhs')
 674
 675 rnCoercion (UfIn  n) = lookupOccRn n `thenRn` \ n' -> returnRn (UfIn  n')
 676 rnCoercion (UfOut n) = lookupOccRn n `thenRn` \ n' -> returnRn (UfOut n')
 677
 678 rnCorePrim (UfOtherOp op)
 679   = lookupOccRn op      `thenRn` \ op' ->
 680     returnRn (UfOtherOp op')
 681
 682 rnCorePrim (UfCCallOp str casm gc arg_tys res_ty)
 683   = mapRn rnHsType arg_tys      `thenRn` \ arg_tys' ->
 684     rnHsType res_ty             `thenRn` \ res_ty' ->
 685     returnRn (UfCCallOp str casm gc arg_tys' res_ty')
 686 \end{code}
 687
 688 %*********************************************************
 689 %*                                                      *
 690 \subsection{Errors}
 691 %*                                                      *
 692 %*********************************************************
 693
 694 \begin{code}
 695 derivingNonStdClassErr clas sty
 696   = hsep [ptext SLIT("non-standard class in deriving:"), ppr sty clas]
 697
 698 classTyVarNotInOpTyErr clas_tyvar sig sty
 699   = hang (hcat [ptext SLIT("Class type variable `"),
 700                        ppr sty clas_tyvar,
 701                        ptext SLIT("' does not appear in method signature:")])
 702          4 (ppr sty sig)
 703
 704 classTyVarInOpCtxtErr clas_tyvar sig sty
 705   = hang (hcat [ ptext SLIT("Class type variable `"), ppr sty clas_tyvar,
 706                         ptext SLIT("' present in method's local overloading context:")])
 707          4 (ppr sty sig)
 708
 709 dupClassAssertWarn ctxt dups sty
 710   = hang (hcat [ptext SLIT("Duplicate class assertion `"),
 711                        ppr sty dups,
 712                        ptext SLIT("' in context:")])
 713          4 (ppr sty ctxt)
 714
 715 badDataCon name sty
 716    = hsep [ptext SLIT("Illegal data constructor name:"), ppr sty name]
 717
 718 allOfNonTyVar ty sty
 719   = hsep [ptext SLIT("`All' applied to a non-type variable:"), ppr sty ty]
 720
 721 ctxtErr doc tyvars sty
 722   = hsep [ptext SLIT("Context constrains type variable(s)"),
 723           hsep (punctuate comma (map (ppr sty) tyvars))]
 724     $$ nest 4 (ptext SLIT("in") <+> doc sty)
 725 \end{code}