ghc/compiler/rename/RnSource.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnSource]{Main pass of renamer}
   5
   6 \begin{code}
   7 module RnSource ( rnIfaceDecl, rnSourceDecls, rnHsType, rnHsSigType ) where
   8
   9 #include "HsVersions.h"
  10
  11 import RnExpr
  12 import HsSyn
  13 import HsDecls          ( HsIdInfo(..), HsStrictnessInfo(..) )
  14 import HsPragmas
  15 import HsTypes          ( getTyVarName, pprClassAssertion, cmpHsTypes )
  16 import RdrHsSyn
  17 import RnHsSyn
  18 import HsCore
  19
  20 import RnBinds          ( rnTopBinds, rnMethodBinds, renameSigs )
  21 import RnEnv            ( bindTyVarsRn, lookupBndrRn, lookupOccRn,
  22                           lookupImplicitOccRn, addImplicitOccRn,
  23                           bindLocalsRn,
  24                           bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvRn,
  25                           checkDupOrQualNames, checkDupNames,
  26                           newLocallyDefinedGlobalName, newImportedGlobalName,
  27                           newImportedGlobalFromRdrName,
  28                           ifaceFlavour, newDFunName,
  29                           FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV
  30                         )
  31 import RnMonad
  32
  33 import Name             ( Name, OccName,
  34                           ExportFlag(..), Provenance(..),
  35                           nameOccName, NamedThing(..), isConOcc,
  36                           mkDefaultMethodOcc, mkDFunOcc
  37                         )
  38 import NameSet
  39 import BasicTypes       ( TopLevelFlag(..), IfaceFlavour(..) )
  40 import TysWiredIn       ( tupleTyCon, unboxedTupleTyCon, listTyCon )
  41 import Type             ( funTyCon )
  42 import FiniteMap        ( elemFM )
  43 import PrelInfo         ( derivingOccurrences, numClass_RDR,
  44                           deRefStablePtr_NAME, makeStablePtr_NAME,
  45                           bindIO_NAME
  46                         )
  47 import Bag              ( bagToList )
  48 import Outputable
  49 import SrcLoc           ( SrcLoc )
  50 import UniqFM           ( lookupUFM )
  51 import Maybes           ( maybeToBool )
  52 import Util
  53 \end{code}
  54
  55 rnDecl `renames' declarations.
  56 It simultaneously performs dependency analysis and precedence parsing.
  57 It also does the following error checks:
  58 \begin{enumerate}
  59 \item
  60 Checks that tyvars are used properly. This includes checking
  61 for undefined tyvars, and tyvars in contexts that are ambiguous.
  62 \item
  63 Checks that all variable occurences are defined.
  64 \item
  65 Checks the (..) etc constraints in the export list.
  66 \end{enumerate}
  67
  68
  69 %*********************************************************
  70 %*                                                      *
  71 \subsection{Value declarations}
  72 %*                                                      *
  73 %*********************************************************
  74
  75 \begin{code}
  76 rnSourceDecls :: [RdrNameHsDecl] -> RnMS s ([RenamedHsDecl], FreeVars)
  77         -- The decls get reversed, but that's ok
  78
  79 rnSourceDecls decls
  80   = go emptyFVs [] decls
  81   where
  82         -- Fixity decls have been dealt with already; ignore them
  83     go fvs ds' []          = returnRn (ds', fvs)
  84     go fvs ds' (FixD _:ds) = go fvs ds' ds
  85     go fvs ds' (d:ds)      = rnDecl d   `thenRn` \(d', fvs) ->
  86                              go (fvs `plusFV` fvs) (d':ds') ds
  87
  88 rnIfaceDecl :: RdrNameHsDecl -> RnMS s RenamedHsDecl
  89 rnIfaceDecl d
  90   = rnDecl d    `thenRn` \ (d', fvs) ->
  91     returnRn d'
  92 \end{code}
  93
  94
  95 %*********************************************************
  96 %*                                                      *
  97 \subsection{Value declarations}
  98 %*                                                      *
  99 %*********************************************************
 100
 101 \begin{code}
 102 -- rnDecl does all the work
 103 rnDecl :: RdrNameHsDecl -> RnMS s (RenamedHsDecl, FreeVars)
 104
 105 rnDecl (ValD binds) = rnTopBinds binds  `thenRn` \ (new_binds, fvs) ->
 106                       returnRn (ValD new_binds, fvs)
 107
 108
 109 rnDecl (SigD (IfaceSig name ty id_infos loc))
 110   = pushSrcLocRn loc $
 111     lookupBndrRn name           `thenRn` \ name' ->
 112     rnIfaceType doc_str ty      `thenRn` \ ty' ->
 113
 114         -- Get the pragma info (if any).
 115     setModeRn (InterfaceMode Optional)          $
 116         -- In all the rest of the signature we read in optional mode,
 117         -- so that (a) we don't die
 118     mapRn rnIdInfo id_infos     `thenRn` \ id_infos' ->
 119     returnRn (SigD (IfaceSig name' ty' id_infos' loc), emptyFVs)
 120                 -- Don't need free-var info for iface binds
 121   where
 122     doc_str = text "the interface signature for" <+> quotes (ppr name)
 123 \end{code}
 124
 125 %*********************************************************
 126 %*                                                      *
 127 \subsection{Type declarations}
 128 %*                                                      *
 129 %*********************************************************
 130
 131 @rnTyDecl@ uses the `global name function' to create a new type
 132 declaration in which local names have been replaced by their original
 133 names, reporting any unknown names.
 134
 135 Renaming type variables is a pain. Because they now contain uniques,
 136 it is necessary to pass in an association list which maps a parsed
 137 tyvar to its Name representation. In some cases (type signatures of
 138 values), it is even necessary to go over the type first in order to
 139 get the set of tyvars used by it, make an assoc list, and then go over
 140 it again to rename the tyvars! However, we can also do some scoping
 141 checks at the same time.
 142
 143 \begin{code}
 144 rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc))
 145   = pushSrcLocRn src_loc $
 146     lookupBndrRn tycon                                  `thenRn` \ tycon' ->
 147     bindTyVarsFVRn data_doc tyvars                      $ \ tyvars' ->
 148     rnContext data_doc context                          `thenRn` \ (context', cxt_fvs) ->
 149     checkDupOrQualNames data_doc con_names              `thenRn_`
 150     mapAndUnzipRn rnConDecl condecls                    `thenRn` \ (condecls', con_fvs_s) ->
 151     rnDerivs derivings                                  `thenRn` \ (derivings', deriv_fvs) ->
 152     ASSERT(isNoDataPragmas pragmas)
 153     returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc),
 154               cxt_fvs `plusFV` plusFVs con_fvs_s `plusFV` deriv_fvs)
 155   where
 156     data_doc = text "the data type declaration for" <+> ppr tycon
 157     con_names = map conDeclName condecls
 158
 159 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
 160   = pushSrcLocRn src_loc $
 161     lookupBndrRn name                           `thenRn` \ name' ->
 162     bindTyVarsFVRn syn_doc tyvars               $ \ tyvars' ->
 163     rnHsType syn_doc ty                         `thenRn` \ (ty', ty_fvs) ->
 164     returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
 165   where
 166     syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
 167
 168 rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname src_loc))
 169   = pushSrcLocRn src_loc $
 170
 171     lookupBndrRn cname                                  `thenRn` \ cname' ->
 172
 173         -- Deal with the implicit tycon and datacon name
 174         -- They aren't in scope (because they aren't visible to the user)
 175         -- and what we want to do is simply look them up in the cache;
 176         -- we jolly well ought to get a 'hit' there!
 177         -- So the 'Imported' part of this call is not relevant.
 178         -- Unclean; but since these two are the only place this happens
 179         -- I can't work up the energy to do it more beautifully
 180     newImportedGlobalFromRdrName tname                  `thenRn` \ tname' ->
 181     newImportedGlobalFromRdrName dname                  `thenRn` \ dname' ->
 182
 183         -- Tyvars scope over bindings and context
 184     bindTyVarsFV2Rn cls_doc tyvars                      ( \ clas_tyvar_names tyvars' ->
 185
 186         -- Check the superclasses
 187     rnContext cls_doc context                           `thenRn` \ (context', cxt_fvs) ->
 188
 189         -- Check the signatures
 190     let
 191                 -- Filter out fixity signatures;
 192                 -- they are done at top level
 193           nofix_sigs = nonFixitySigs sigs
 194     in
 195     checkDupOrQualNames sig_doc sig_rdr_names_w_locs            `thenRn_`
 196     mapAndUnzipRn (rn_op cname' clas_tyvar_names) nofix_sigs    `thenRn` \ (sigs', sig_fvs_s) ->
 197
 198         -- Check the methods
 199     checkDupOrQualNames meth_doc meth_rdr_names_w_locs  `thenRn_`
 200     rnMethodBinds mbinds                                `thenRn` \ (mbinds', meth_fvs) ->
 201
 202         -- Typechecker is responsible for checking that we only
 203         -- give default-method bindings for things in this class.
 204         -- The renamer *could* check this for class decls, but can't
 205         -- for instance decls.
 206
 207     ASSERT(isNoClassPragmas pragmas)
 208     returnRn (TyClD (ClassDecl context' cname' tyvars' sigs' mbinds' NoClassPragmas tname' dname' src_loc),
 209               plusFVs sig_fvs_s `plusFV` cxt_fvs `plusFV` meth_fvs)
 210     )
 211   where
 212     cls_doc  = text "the declaration for class"         <+> ppr cname
 213     sig_doc  = text "the signatures for class"          <+> ppr cname
 214     meth_doc = text "the default-methods for class"     <+> ppr cname
 215
 216     sig_rdr_names_w_locs  = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
 217     meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
 218     meth_rdr_names        = map fst meth_rdr_names_w_locs
 219
 220     rn_op clas clas_tyvars sig@(ClassOpSig op maybe_dm ty locn)
 221       = pushSrcLocRn locn $
 222         lookupBndrRn op                         `thenRn` \ op_name ->
 223
 224                 -- Check the signature
 225         rnHsSigType (quotes (ppr op)) ty        `thenRn` \ (new_ty, op_ty_fvs)  ->
 226         let
 227             check_in_op_ty clas_tyvar = checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
 228                                                 (classTyVarNotInOpTyErr clas_tyvar sig)
 229         in
 230         mapRn check_in_op_ty clas_tyvars                 `thenRn_`
 231
 232                 -- Make the default-method name
 233         let
 234             dm_occ = mkDefaultMethodOcc (rdrNameOcc op)
 235         in
 236         getModuleRn                     `thenRn` \ mod_name ->
 237         getModeRn                       `thenRn` \ mode ->
 238         (case (mode, maybe_dm) of
 239             (SourceMode, _) | op `elem` meth_rdr_names
 240                 ->      -- There's an explicit method decl
 241                    newLocallyDefinedGlobalName mod_name dm_occ
 242                                                (\_ -> Exported) locn    `thenRn` \ dm_name ->
 243                    returnRn (Just dm_name)
 244
 245             (InterfaceMode _, Just _)
 246                 ->      -- Imported class that has a default method decl
 247                     newImportedGlobalName mod_name dm_occ (ifaceFlavour clas)   `thenRn` \ dm_name ->
 248                     addOccurrenceName dm_name                                   `thenRn_`
 249                     returnRn (Just dm_name)
 250
 251             other -> returnRn Nothing
 252         )                                       `thenRn` \ maybe_dm_name ->
 253
 254
 255         returnRn (ClassOpSig op_name maybe_dm_name new_ty locn, op_ty_fvs)
 256 \end{code}
 257
 258
 259 %*********************************************************
 260 %*                                                      *
 261 \subsection{Instance declarations}
 262 %*                                                      *
 263 %*********************************************************
 264
 265 \begin{code}
 266 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
 267   = pushSrcLocRn src_loc $
 268     rnHsSigType (text "an instance decl") inst_ty       `thenRn` \ (inst_ty', inst_fvs) ->
 269     let
 270         inst_tyvars = case inst_ty' of
 271                         HsForAllTy inst_tyvars _ _ -> inst_tyvars
 272                         other                      -> []
 273         -- (Slightly strangely) the forall-d tyvars scope over
 274         -- the method bindings too
 275     in
 276     extendTyVarEnvRn inst_tyvars                $
 277
 278         -- Rename the bindings
 279         -- NB meth_names can be qualified!
 280     checkDupNames meth_doc meth_names           `thenRn_`
 281     rnMethodBinds mbinds                        `thenRn` \ (mbinds', meth_fvs) ->
 282     let
 283         binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds')))
 284     in
 285     renameSigs NotTopLevel True binders uprags  `thenRn` \ new_uprags ->
 286     mkDFunName inst_ty' maybe_dfun src_loc      `thenRn` \ dfun_name ->
 287     addOccurrenceName dfun_name                 `thenRn_`
 288                         -- The dfun is not optional, because we use its version number
 289                         -- to identify the version of the instance declaration
 290
 291         -- The typechecker checks that all the bindings are for the right class.
 292     returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc),
 293               inst_fvs `plusFV` meth_fvs)
 294   where
 295     meth_doc = text "the bindings in an instance declaration"
 296     meth_names   = bagToList (collectMonoBinders mbinds)
 297 \end{code}
 298
 299 %*********************************************************
 300 %*                                                      *
 301 \subsection{Default declarations}
 302 %*                                                      *
 303 %*********************************************************
 304
 305 \begin{code}
 306 rnDecl (DefD (DefaultDecl tys src_loc))
 307   = pushSrcLocRn src_loc $
 308     rnHsTypes doc_str tys               `thenRn` \ (tys', fvs) ->
 309     lookupImplicitOccRn numClass_RDR    `thenRn_`
 310     returnRn (DefD (DefaultDecl tys' src_loc), fvs)
 311   where
 312     doc_str = text "a `default' declaration"
 313 \end{code}
 314
 315 %*********************************************************
 316 %*                                                      *
 317 \subsection{Foreign declarations}
 318 %*                                                      *
 319 %*********************************************************
 320
 321 \begin{code}
 322 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
 323   = pushSrcLocRn src_loc $
 324     lookupBndrRn name                   `thenRn` \ name' ->
 325     (case imp_exp of
 326         FoImport _ | not isDyn -> addImplicitOccRn name'
 327         FoLabel    -> addImplicitOccRn name'
 328         FoExport   | isDyn ->
 329            addImplicitOccRn makeStablePtr_NAME  `thenRn_`
 330            addImplicitOccRn deRefStablePtr_NAME `thenRn_`
 331            addImplicitOccRn bindIO_NAME         `thenRn_`
 332            returnRn name'
 333         _ -> returnRn name')            `thenRn_`
 334     rnHsSigType fo_decl_msg ty          `thenRn` \ (ty', fvs) ->
 335     returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc), fvs)
 336  where
 337   fo_decl_msg = ptext SLIT("a foreign declaration")
 338   isDyn       = isDynamic ext_nm
 339
 340 \end{code}
 341
 342 %*********************************************************
 343 %*                                                      *
 344 \subsection{Support code for type/data declarations}
 345 %*                                                      *
 346 %*********************************************************
 347
 348 \begin{code}
 349 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name], FreeVars)
 350
 351 rnDerivs Nothing -- derivs not specified
 352   = returnRn (Nothing, emptyFVs)
 353
 354 rnDerivs (Just ds)
 355   = mapRn rn_deriv ds `thenRn` \ derivs ->
 356     returnRn (Just derivs, mkNameSet derivs)
 357   where
 358     rn_deriv clas
 359       = lookupOccRn clas            `thenRn` \ clas_name ->
 360
 361                 -- Now add extra "occurrences" for things that
 362                 -- the deriving mechanism will later need in order to
 363                 -- generate code for this class.
 364         case lookupUFM derivingOccurrences clas_name of
 365                 Nothing -> addErrRn (derivingNonStdClassErr clas_name)  `thenRn_`
 366                            returnRn clas_name
 367
 368                 Just occs -> mapRn lookupImplicitOccRn occs     `thenRn_`
 369                              returnRn clas_name
 370
 371 \end{code}
 372
 373 \begin{code}
 374 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
 375 conDeclName (ConDecl n _ _ _ l) = (n,l)
 376
 377 rnConDecl :: RdrNameConDecl -> RnMS s (RenamedConDecl, FreeVars)
 378 rnConDecl (ConDecl name tvs cxt details locn)
 379   = pushSrcLocRn locn $
 380     checkConName name                   `thenRn_`
 381     lookupBndrRn name                   `thenRn` \ new_name ->
 382     bindTyVarsFVRn doc tvs              $ \ new_tyvars ->
 383     rnContext doc cxt                   `thenRn` \ (new_context, cxt_fvs) ->
 384     rnConDetails doc locn details       `thenRn` \ (new_details, det_fvs) ->
 385     returnRn (ConDecl new_name new_tyvars new_context new_details locn,
 386               cxt_fvs `plusFV` det_fvs)
 387   where
 388     doc = text "the definition of data constructor" <+> quotes (ppr name)
 389
 390 rnConDetails doc locn (VanillaCon tys)
 391   = mapAndUnzipRn (rnBangTy doc) tys    `thenRn` \ (new_tys, fvs_s)  ->
 392     returnRn (VanillaCon new_tys, plusFVs fvs_s)
 393
 394 rnConDetails doc locn (InfixCon ty1 ty2)
 395   = rnBangTy doc ty1            `thenRn` \ (new_ty1, fvs1) ->
 396     rnBangTy doc ty2            `thenRn` \ (new_ty2, fvs2) ->
 397     returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
 398
 399 rnConDetails doc locn (NewCon ty mb_field)
 400   = rnHsType doc ty                     `thenRn` \ (new_ty, fvs) ->
 401     rn_field mb_field                   `thenRn` \ new_mb_field  ->
 402     returnRn (NewCon new_ty new_mb_field, fvs)
 403   where
 404     rn_field Nothing  = returnRn Nothing
 405     rn_field (Just f) =
 406        lookupBndrRn f       `thenRn` \ new_f ->
 407        returnRn (Just new_f)
 408
 409 rnConDetails doc locn (RecCon fields)
 410   = checkDupOrQualNames doc field_names `thenRn_`
 411     mapAndUnzipRn (rnField doc) fields  `thenRn` \ (new_fields, fvs_s) ->
 412     returnRn (RecCon new_fields, plusFVs fvs_s)
 413   where
 414     field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
 415
 416 rnField doc (names, ty)
 417   = mapRn lookupBndrRn names    `thenRn` \ new_names ->
 418     rnBangTy doc ty             `thenRn` \ (new_ty, fvs) ->
 419     returnRn ((new_names, new_ty), fvs)
 420
 421 rnBangTy doc (Banged ty)
 422   = rnHsType doc ty             `thenRn` \ (new_ty, fvs) ->
 423     returnRn (Banged new_ty, fvs)
 424
 425 rnBangTy doc (Unbanged ty)
 426   = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
 427     returnRn (Unbanged new_ty, fvs)
 428
 429 -- This data decl will parse OK
 430 --      data T = a Int
 431 -- treating "a" as the constructor.
 432 -- It is really hard to make the parser spot this malformation.
 433 -- So the renamer has to check that the constructor is legal
 434 --
 435 -- We can get an operator as the constructor, even in the prefix form:
 436 --      data T = :% Int Int
 437 -- from interface files, which always print in prefix form
 438
 439 checkConName name
 440   = checkRn (isConOcc (rdrNameOcc name))
 441             (badDataCon name)
 442 \end{code}
 443
 444
 445 %*********************************************************
 446 %*                                                      *
 447 \subsection{Naming a dfun}
 448 %*                                                      *
 449 %*********************************************************
 450
 451 Make a name for the dict fun for an instance decl
 452
 453 \begin{code}
 454 mkDFunName :: RenamedHsType     -- Instance type
 455             -> Maybe RdrName    -- Dfun thing from decl; Nothing <=> source
 456             -> SrcLoc
 457             -> RnMS s Name
 458
 459 mkDFunName inst_ty maybe_df src_loc
 460   = newDFunName cl_occ tycon_occ maybe_df src_loc
 461   where
 462     (cl_occ, tycon_occ) = get_key inst_ty
 463
 464     get_key (HsForAllTy _ _ ty)     = get_key ty
 465     get_key (MonoFunTy _ ty)        = get_key ty
 466     get_key (MonoDictTy cls (ty:_)) = (nameOccName cls, get_tycon_key ty)
 467
 468     get_tycon_key (MonoTyVar tv)   = nameOccName (getName tv)
 469     get_tycon_key (MonoTyApp ty _) = get_tycon_key ty
 470     get_tycon_key (MonoTupleTy tys True)  = getOccName (tupleTyCon        (length tys))
 471     get_tycon_key (MonoTupleTy tys False) = getOccName (unboxedTupleTyCon (length tys))
 472     get_tycon_key (MonoListTy _)   = getOccName listTyCon
 473     get_tycon_key (MonoFunTy _ _)  = getOccName funTyCon
 474 \end{code}
 475
 476
 477 %*********************************************************
 478 %*                                                      *
 479 \subsection{Support code to rename types}
 480 %*                                                      *
 481 %*********************************************************
 482
 483 \begin{code}
 484 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
 485         -- rnHsSigType is used for source-language type signatures,
 486         -- which use *implicit* universal quantification.
 487 rnHsSigType doc_str ty
 488   = rnHsType (text "the type signature for" <+> doc_str) ty
 489
 490 rnIfaceType :: SDoc -> RdrNameHsType -> RnMS s RenamedHsType
 491 rnIfaceType doc ty
 492  = rnHsType doc ty      `thenRn` \ (ty,_) ->
 493    returnRn ty
 494
 495 rnHsType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
 496
 497 rnHsType doc (HsForAllTy [] ctxt ty)
 498         -- From source code (no kinds on tyvars)
 499
 500         -- Given the signature  C => T  we universally quantify
 501         -- over FV(T) \ {in-scope-tyvars}
 502         --
 503         -- We insist that the universally quantified type vars is a superset of FV(C)
 504         -- It follows that FV(T) is a superset of FV(C), so that the context constrains
 505         -- no type variables that don't appear free in the tau-type part.
 506
 507   = getLocalNameEnv             `thenRn` \ name_env ->
 508     let
 509         mentioned_tyvars = extractHsTyVars ty
 510         forall_tyvars    = filter (not . (`elemFM` name_env)) mentioned_tyvars
 511
 512         ctxt_w_ftvs :: [((RdrName,[RdrNameHsType]), [RdrName])]
 513         ctxt_w_ftvs  = [ (constraint, foldr ((++) . extractHsTyVars) [] tys)
 514                        | constraint@(_,tys) <- ctxt]
 515
 516         -- A 'non-poly constraint' is one that does not mention *any*
 517         -- of the forall'd type variables
 518         non_poly_constraints = filter non_poly ctxt_w_ftvs
 519         non_poly (c,ftvs)    = not (any (`elem` forall_tyvars) ftvs)
 520
 521         -- A 'non-mentioned' constraint is one that mentions a
 522         -- type variable that does not appear in 'ty'
 523         non_mentioned_constraints = filter non_mentioned ctxt_w_ftvs
 524         non_mentioned (c,ftvs)    = any (not . (`elem` mentioned_tyvars)) ftvs
 525
 526         -- Zap the context if there's a problem, to avoid duplicate error message.
 527         ctxt' | null non_poly_constraints && null non_mentioned_constraints = ctxt
 528               | otherwise = []
 529     in
 530     mapRn (ctxtErr1 doc forall_tyvars ty) non_poly_constraints          `thenRn_`
 531     mapRn (ctxtErr2 doc ty)               non_mentioned_constraints     `thenRn_`
 532
 533     (bindTyVarsFVRn doc (map UserTyVar forall_tyvars)   $ \ new_tyvars ->
 534     rnContext doc ctxt'                                 `thenRn` \ (new_ctxt, cxt_fvs) ->
 535     rnHsType doc ty                                     `thenRn` \ (new_ty, ty_fvs) ->
 536     returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty,
 537               cxt_fvs `plusFV` ty_fvs)
 538     )
 539
 540 rnHsType doc (HsForAllTy tvs ctxt ty)
 541         -- tvs are non-empty, hence must be from an interface file
 542         --      (tyvars may be kinded)
 543   = bindTyVarsFVRn doc tvs              $ \ new_tyvars ->
 544     rnContext doc ctxt                  `thenRn` \ (new_ctxt, cxt_fvs) ->
 545     rnHsType doc ty                     `thenRn` \ (new_ty, ty_fvs) ->
 546     returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty,
 547               cxt_fvs `plusFV` ty_fvs)
 548
 549 rnHsType doc (MonoTyVar tyvar)
 550   = lookupOccRn tyvar           `thenRn` \ tyvar' ->
 551     returnRn (MonoTyVar tyvar', unitFV tyvar')
 552
 553 rnHsType doc (MonoFunTy ty1 ty2)
 554   = rnHsType doc ty1    `thenRn` \ (ty1', fvs1) ->
 555     rnHsType doc ty2    `thenRn` \ (ty2', fvs2) ->
 556     returnRn (MonoFunTy ty1' ty2', fvs1 `plusFV` fvs2)
 557
 558 rnHsType doc (MonoListTy ty)
 559   = addImplicitOccRn listTyCon_name             `thenRn_`
 560     rnHsType doc ty                             `thenRn` \ (ty', fvs) ->
 561     returnRn (MonoListTy ty', fvs `addOneFV` listTyCon_name)
 562
 563 rnHsType doc (MonoTupleTy tys boxed)
 564   = addImplicitOccRn tup_con_name       `thenRn_`
 565     rnHsTypes doc tys                   `thenRn` \ (tys', fvs) ->
 566     returnRn (MonoTupleTy tys' boxed, fvs `addOneFV` tup_con_name)
 567   where
 568     tup_con_name = tupleTyCon_name boxed (length tys)
 569
 570 rnHsType doc (MonoTyApp ty1 ty2)
 571   = rnHsType doc ty1            `thenRn` \ (ty1', fvs1) ->
 572     rnHsType doc ty2            `thenRn` \ (ty2', fvs2) ->
 573     returnRn (MonoTyApp ty1' ty2', fvs1 `plusFV` fvs2)
 574
 575 rnHsType doc (MonoDictTy clas tys)
 576   = lookupOccRn clas            `thenRn` \ clas' ->
 577     rnHsTypes doc tys           `thenRn` \ (tys', fvs) ->
 578     returnRn (MonoDictTy clas' tys', fvs `addOneFV` clas')
 579
 580 rnHsTypes doc tys
 581   = mapAndUnzipRn (rnHsType doc) tys    `thenRn` \ (tys, fvs_s) ->
 582     returnRn (tys, plusFVs fvs_s)
 583 \end{code}
 584
 585
 586 \begin{code}
 587 rnContext :: SDoc -> RdrNameContext -> RnMS s (RenamedContext, FreeVars)
 588
 589 rnContext doc ctxt
 590   = mapAndUnzipRn rn_ctxt ctxt          `thenRn` \ (theta, fvs_s) ->
 591     let
 592         (_, dup_asserts) = removeDups cmp_assert theta
 593     in
 594         -- Check for duplicate assertions
 595         -- If this isn't an error, then it ought to be:
 596     mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts    `thenRn_`
 597
 598     returnRn (theta, plusFVs fvs_s)
 599   where
 600     rn_ctxt (clas, tys)
 601       = lookupOccRn clas                `thenRn` \ clas_name ->
 602         rnHsTypes doc tys               `thenRn` \ (tys', fvs) ->
 603         returnRn ((clas_name, tys'), fvs `addOneFV` clas_name)
 604
 605     cmp_assert (c1,tys1) (c2,tys2)
 606       = (c1 `compare` c2) `thenCmp` (cmpHsTypes compare tys1 tys2)
 607 \end{code}
 608
 609
 610 %*********************************************************
 611 %*                                                      *
 612 \subsection{IdInfo}
 613 %*                                                      *
 614 %*********************************************************
 615
 616 \begin{code}
 617 rnIdInfo (HsStrictness strict)
 618   = rnStrict strict     `thenRn` \ strict' ->
 619     returnRn (HsStrictness strict')
 620
 621 rnIdInfo (HsUnfold inline (Just expr))  = rnCoreExpr expr       `thenRn` \ expr' ->
 622                                           returnRn (HsUnfold inline (Just expr'))
 623 rnIdInfo (HsUnfold inline Nothing)      = returnRn (HsUnfold inline Nothing)
 624 rnIdInfo (HsArity arity)        = returnRn (HsArity arity)
 625 rnIdInfo (HsUpdate update)      = returnRn (HsUpdate update)
 626 rnIdInfo (HsNoCafRefs)          = returnRn (HsNoCafRefs)
 627 rnIdInfo (HsSpecialise tyvars tys expr)
 628   = bindTyVarsRn doc tyvars     $ \ tyvars' ->
 629     rnCoreExpr expr             `thenRn` \ expr' ->
 630     mapRn (rnIfaceType doc) tys `thenRn` \ tys' ->
 631     returnRn (HsSpecialise tyvars' tys' expr')
 632   where
 633     doc = text "Specialise in interface pragma"
 634
 635
 636 rnStrict (HsStrictnessInfo demands (Just (worker,cons)))
 637         -- The sole purpose of the "cons" field is so that we can mark the constructors
 638         -- needed to build the wrapper as "needed", so that their data type decl will be
 639         -- slurped in. After that their usefulness is o'er, so we just put in the empty list.
 640   = lookupOccRn worker                  `thenRn` \ worker' ->
 641     mapRn lookupOccRn cons              `thenRn_`
 642     returnRn (HsStrictnessInfo demands (Just (worker',[])))
 643
 644 -- Boring, but necessary for the type checker.
 645 rnStrict (HsStrictnessInfo demands Nothing) = returnRn (HsStrictnessInfo demands Nothing)
 646 rnStrict HsBottom                         = returnRn HsBottom
 647 \end{code}
 648
 649 UfCore expressions.
 650
 651 \begin{code}
 652 rnCoreExpr (UfType ty)
 653   = rnIfaceType (text "unfolding type") ty      `thenRn` \ ty' ->
 654     returnRn (UfType ty')
 655
 656 rnCoreExpr (UfVar v)
 657   = lookupOccRn v       `thenRn` \ v' ->
 658     returnRn (UfVar v')
 659
 660 rnCoreExpr (UfCon con args)
 661   = rnUfCon con                 `thenRn` \ con' ->
 662     mapRn rnCoreExpr args       `thenRn` \ args' ->
 663     returnRn (UfCon con' args')
 664
 665 rnCoreExpr (UfTuple con args)
 666   = lookupOccRn con             `thenRn` \ con' ->
 667     mapRn rnCoreExpr args       `thenRn` \ args' ->
 668     returnRn (UfTuple con' args')
 669
 670 rnCoreExpr (UfApp fun arg)
 671   = rnCoreExpr fun              `thenRn` \ fun' ->
 672     rnCoreExpr arg              `thenRn` \ arg' ->
 673     returnRn (UfApp fun' arg')
 674
 675 rnCoreExpr (UfCase scrut bndr alts)
 676   = rnCoreExpr scrut                    `thenRn` \ scrut' ->
 677     bindLocalsRn "UfCase" [bndr]        $ \ [bndr'] ->
 678     mapRn rnCoreAlt alts                `thenRn` \ alts' ->
 679     returnRn (UfCase scrut' bndr' alts')
 680
 681 rnCoreExpr (UfNote note expr)
 682   = rnNote note                 `thenRn` \ note' ->
 683     rnCoreExpr expr             `thenRn` \ expr' ->
 684     returnRn  (UfNote note' expr')
 685
 686 rnCoreExpr (UfLam bndr body)
 687   = rnCoreBndr bndr             $ \ bndr' ->
 688     rnCoreExpr body             `thenRn` \ body' ->
 689     returnRn (UfLam bndr' body')
 690
 691 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
 692   = rnCoreExpr rhs              `thenRn` \ rhs' ->
 693     rnCoreBndr bndr             $ \ bndr' ->
 694     rnCoreExpr body             `thenRn` \ body' ->
 695     returnRn (UfLet (UfNonRec bndr' rhs') body')
 696
 697 rnCoreExpr (UfLet (UfRec pairs) body)
 698   = rnCoreBndrs bndrs           $ \ bndrs' ->
 699     mapRn rnCoreExpr rhss       `thenRn` \ rhss' ->
 700     rnCoreExpr body             `thenRn` \ body' ->
 701     returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
 702   where
 703     (bndrs, rhss) = unzip pairs
 704 \end{code}
 705
 706 \begin{code}
 707 rnCoreBndr (UfValBinder name ty) thing_inside
 708   = rnIfaceType (text str) ty   `thenRn` \ ty' ->
 709     bindLocalsRn str [name]     $ \ [name'] ->
 710     thing_inside (UfValBinder name' ty')
 711   where
 712     str = "unfolding id"
 713
 714 rnCoreBndr (UfTyBinder name kind) thing_inside
 715   = bindLocalsRn "unfolding tyvar" [name] $ \ [name'] ->
 716     thing_inside (UfTyBinder name' kind)
 717
 718 rnCoreBndrs bndrs thing_inside          -- Expect them all to be ValBinders
 719   = mapRn (rnIfaceType (text str)) tys  `thenRn` \ tys' ->
 720     bindLocalsRn str names              $ \ names' ->
 721     thing_inside (zipWith UfValBinder names' tys')
 722   where
 723     str   = "unfolding id"
 724     names = map (\ (UfValBinder name _ ) -> name) bndrs
 725     tys   = map (\ (UfValBinder _    ty) -> ty)   bndrs
 726 \end{code}
 727
 728 \begin{code}
 729 rnCoreAlt (con, bndrs, rhs)
 730   = rnUfCon con                         `thenRn` \ con' ->
 731     bindLocalsRn "unfolding alt" bndrs  $ \ bndrs' ->
 732     rnCoreExpr rhs                      `thenRn` \ rhs' ->
 733     returnRn (con', bndrs', rhs')
 734
 735
 736 rnNote (UfCoerce ty)
 737   = rnIfaceType (text "unfolding coerce") ty    `thenRn` \ ty' ->
 738     returnRn (UfCoerce ty')
 739
 740 rnNote (UfSCC cc)   = returnRn (UfSCC cc)
 741 rnNote UfInlineCall = returnRn UfInlineCall
 742
 743
 744 rnUfCon UfDefault
 745   = returnRn UfDefault
 746
 747 rnUfCon (UfDataCon con)
 748   = lookupOccRn con             `thenRn` \ con' ->
 749     returnRn (UfDataCon con')
 750
 751 rnUfCon (UfLitCon lit)
 752   = returnRn (UfLitCon lit)
 753
 754 rnUfCon (UfLitLitCon lit ty)
 755   = rnIfaceType (text "litlit") ty              `thenRn` \ ty' ->
 756     returnRn (UfLitLitCon lit ty')
 757
 758 rnUfCon (UfPrimOp op)
 759   = lookupOccRn op              `thenRn` \ op' ->
 760     returnRn (UfPrimOp op')
 761
 762 rnUfCon (UfCCallOp str casm gc)
 763   = returnRn (UfCCallOp str casm gc)
 764 \end{code}
 765
 766 %*********************************************************
 767 %*                                                      *
 768 \subsection{Errors}
 769 %*                                                      *
 770 %*********************************************************
 771
 772 \begin{code}
 773 derivingNonStdClassErr clas
 774   = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
 775
 776 classTyVarNotInOpTyErr clas_tyvar sig
 777   = hang (hsep [ptext SLIT("Class type variable"),
 778                        quotes (ppr clas_tyvar),
 779                        ptext SLIT("does not appear in method signature")])
 780          4 (ppr sig)
 781
 782 dupClassAssertWarn ctxt (assertion : dups)
 783   = sep [hsep [ptext SLIT("Duplicate class assertion"),
 784                quotes (pprClassAssertion assertion),
 785                ptext SLIT("in the context:")],
 786          nest 4 (pprContext ctxt)]
 787
 788 badDataCon name
 789    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 790
 791 ctxtErr1 doc tyvars ty (constraint, _)
 792   = addErrRn (
 793       sep [ptext SLIT("The constraint") <+> quotes (pprClassAssertion constraint) <+>
 794                    ptext SLIT("does not mention any of"),
 795            nest 4 (ptext SLIT("the universally quantified type variables") <+> braces (interpp'SP tyvars)),
 796            nest 4 (ptext SLIT("of the type") <+> quotes (ppr ty))
 797       ]
 798       $$
 799       (ptext SLIT("In") <+> doc)
 800     )
 801
 802 ctxtErr2 doc ty (constraint,_)
 803   = addErrRn (
 804         sep [ptext SLIT("The constraint") <+> quotes (pprClassAssertion constraint),
 805         nest 4 (ptext SLIT("mentions type variables that do not appear in the type")),
 806         nest 4 (quotes (ppr ty))]
 807         $$
 808         (ptext SLIT("In") <+> doc)
 809     )
 810 \end{code}