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