ghc/compiler/rename/Rename.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1992-1998
   3 %
   4 \section[Rename]{Renaming and dependency analysis passes}
   5
   6 \begin{code}
   7 module Rename ( renameModule ) where
   8
   9 #include "HsVersions.h"
  10
  11 import HsSyn
  12 import RdrHsSyn         ( RdrName(..), RdrNameHsModule )
  13 import RnHsSyn          ( RenamedHsModule, RenamedHsDecl, extractHsTyNames )
  14
  15 import CmdLineOpts      ( opt_HiMap, opt_D_show_rn_trace,
  16                           opt_D_dump_rn, opt_D_show_rn_stats,
  17                           opt_WarnUnusedBinds, opt_WarnUnusedImports
  18                         )
  19 import RnMonad
  20 import RnNames          ( getGlobalNames )
  21 import RnSource         ( rnDecl )
  22 import RnIfaces         ( getImportedInstDecls, importDecl, getImportVersions, getSpecialInstModules,
  23                           getDeferredDataDecls,
  24                           mkSearchPath, getSlurpedNames, getRnStats
  25                         )
  26 import RnEnv            ( addImplicitOccsRn, availNames )
  27 import Name             ( Name, isLocallyDefined,
  28                           NamedThing(..),
  29                           nameModule, pprModule, pprOccName, nameOccName
  30                         )
  31 import NameSet
  32 import TyCon            ( TyCon )
  33 import PrelMods         ( mAIN, pREL_MAIN )
  34 import TysWiredIn       ( unitTyCon, intTyCon, doubleTyCon )
  35 import PrelInfo         ( ioTyCon_NAME, thinAirIdNames )
  36 import ErrUtils         ( pprBagOfErrors, pprBagOfWarnings,
  37                           doIfSet, dumpIfSet, ghcExit
  38                         )
  39 import Bag              ( isEmptyBag )
  40 import FiniteMap        ( fmToList, delListFromFM )
  41 import UniqSupply       ( UniqSupply )
  42 import Util             ( equivClasses )
  43 import Maybes           ( maybeToBool )
  44 import Outputable
  45 \end{code}
  46
  47
  48
  49 \begin{code}
  50 renameModule :: UniqSupply
  51              -> RdrNameHsModule
  52              -> IO (Maybe
  53                       ( RenamedHsModule   -- Output, after renaming
  54                       , InterfaceDetails  -- Interface; for interface file generatino
  55                       , RnNameSupply      -- Final env; for renaming derivings
  56                       , [Module]          -- Imported modules; for profiling
  57                       ))
  58
  59 renameModule us this_mod@(HsModule mod_name vers exports imports fixities local_decls loc)
  60   =     -- Initialise the renamer monad
  61     initRn mod_name us (mkSearchPath opt_HiMap) loc
  62            (rename this_mod)                            >>=
  63         \ (maybe_rn_stuff, rn_errs_bag, rn_warns_bag) ->
  64
  65         -- Check for warnings
  66     doIfSet (not (isEmptyBag rn_warns_bag))
  67             (printErrs (pprBagOfWarnings rn_warns_bag)) >>
  68
  69         -- Check for errors; exit if so
  70     doIfSet (not (isEmptyBag rn_errs_bag))
  71             (printErrs (pprBagOfErrors rn_errs_bag)      >>
  72              ghcExit 1
  73             )                                            >>
  74
  75         -- Dump output, if any
  76     (case maybe_rn_stuff of
  77         Nothing  -> return ()
  78         Just results@(rn_mod, _, _, _)
  79                  -> dumpIfSet opt_D_dump_rn "Renamer:"
  80                               (ppr rn_mod)
  81     )                                                   >>
  82
  83         -- Return results
  84     return maybe_rn_stuff
  85 \end{code}
  86
  87
  88 \begin{code}
  89 rename this_mod@(HsModule mod_name vers exports imports fixities local_decls loc)
  90   =     -- FIND THE GLOBAL NAME ENVIRONMENT
  91     getGlobalNames this_mod                     `thenRn` \ maybe_stuff ->
  92
  93         -- CHECK FOR EARLY EXIT
  94     if not (maybeToBool maybe_stuff) then
  95         -- Everything is up to date; no need to recompile further
  96         rnStats []              `thenRn_`
  97         returnRn Nothing
  98     else
  99     let
 100         Just (export_env, rn_env, explicit_info, print_unqual) = maybe_stuff
 101     in
 102
 103         -- RENAME THE SOURCE
 104     initRnMS rn_env mod_name SourceMode (
 105         addImplicits mod_name                           `thenRn_`
 106         mapRn rnDecl local_decls
 107     )                                                   `thenRn` \ rn_local_decls ->
 108
 109         -- SLURP IN ALL THE NEEDED DECLARATIONS
 110     slurpDecls print_unqual rn_local_decls              `thenRn` \ rn_all_decls ->
 111
 112         -- EXIT IF ERRORS FOUND
 113     checkErrsRn                         `thenRn` \ no_errs_so_far ->
 114     if not no_errs_so_far then
 115         -- Found errors already, so exit now
 116         rnStats []              `thenRn_`
 117         returnRn Nothing
 118     else
 119
 120         -- GENERATE THE VERSION/USAGE INFO
 121     getImportVersions mod_name exports                  `thenRn` \ import_versions ->
 122     getNameSupplyRn                                     `thenRn` \ name_supply ->
 123
 124         -- REPORT UNUSED NAMES
 125     reportUnusedNames export_env explicit_info          `thenRn_`
 126
 127         -- GENERATE THE SPECIAL-INSTANCE MODULE LIST
 128         -- The "special instance" modules are those modules that contain instance
 129         -- declarations that contain no type constructor or class that was declared
 130         -- in that module.
 131     getSpecialInstModules                               `thenRn` \ imported_special_inst_mods ->
 132     let
 133         special_inst_decls = [d | InstD d@(InstDecl inst_ty _ _ _ _) <- rn_local_decls,
 134                                   all (not.isLocallyDefined) (nameSetToList (extractHsTyNames inst_ty))
 135                              ]
 136         special_inst_mods | null special_inst_decls = imported_special_inst_mods
 137                           | otherwise               = mod_name : imported_special_inst_mods
 138     in
 139
 140
 141         -- RETURN THE RENAMED MODULE
 142     let
 143         import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
 144
 145         renamed_module = HsModule mod_name vers
 146                                   trashed_exports trashed_imports trashed_fixities
 147                                   rn_all_decls
 148                                   loc
 149     in
 150     rnStats rn_all_decls        `thenRn_`
 151     returnRn (Just (renamed_module,
 152                     (import_versions, export_env, special_inst_mods),
 153                      name_supply,
 154                      import_mods))
 155   where
 156     trashed_exports  = {-trace "rnSource:trashed_exports"-} Nothing
 157     trashed_imports  = {-trace "rnSource:trashed_imports"-} []
 158     trashed_fixities = []
 159 \end{code}
 160
 161 @addImplicits@ forces the renamer to slurp in some things which aren't
 162 mentioned explicitly, but which might be needed by the type checker.
 163
 164 \begin{code}
 165 addImplicits mod_name
 166   = addImplicitOccsRn (implicit_main ++ default_tys ++ thinAirIdNames)
 167   where
 168         -- Add occurrences for Int, Double, and (), because they
 169         -- are the types to which ambigious type variables may be defaulted by
 170         -- the type checker; so they won't always appear explicitly.
 171         -- [The () one is a GHC extension for defaulting CCall results.]
 172     default_tys = [getName intTyCon, getName doubleTyCon, getName unitTyCon ]
 173
 174         -- Add occurrences for IO or PrimIO
 175     implicit_main |  mod_name == mAIN
 176                   || mod_name == pREL_MAIN = [ioTyCon_NAME]
 177                   |  otherwise             = []
 178 \end{code}
 179
 180
 181 \begin{code}
 182 slurpDecls print_unqual decls
 183   =     -- First of all, get all the compulsory decls
 184     slurp_compulsories decls    `thenRn` \ decls1 ->
 185
 186         -- Next get the optional ones
 187     closeDecls optional_mode decls1     `thenRn` \ decls2 ->
 188
 189         -- Finally get those deferred data type declarations
 190     getDeferredDataDecls                                `thenRn` \ data_decls ->
 191     mapRn (rn_data_decl compulsory_mode) data_decls     `thenRn` \ rn_data_decls ->
 192
 193         -- Done
 194     returnRn (rn_data_decls ++ decls2)
 195
 196   where
 197     compulsory_mode = InterfaceMode Compulsory print_unqual
 198     optional_mode   = InterfaceMode Optional   print_unqual
 199
 200         -- The "slurp_compulsories" function is a loop that alternates
 201         -- between slurping compulsory decls and slurping the instance
 202         -- decls thus made relavant.
 203         -- We *must* loop again here.  Why?  Two reasons:
 204         -- (a) an instance decl will give rise to an unresolved dfun, whose
 205         --      decl we must slurp to get its version number; that's the version
 206         --      number for the whole instance decl.  (And its unfolding might mention new
 207         --  unresolved names.)
 208         -- (b) an instance decl might give rise to a new unresolved class,
 209         --      whose decl we must slurp, which might let in some new instance decls,
 210         --      and so on.  Example:  instance Foo a => Baz [a] where ...
 211     slurp_compulsories decls
 212       = closeDecls compulsory_mode decls        `thenRn` \ decls1 ->
 213
 214                 -- Instance decls still pending?
 215         getImportedInstDecls                    `thenRn` \ inst_decls ->
 216         if null inst_decls then
 217                 -- No, none
 218             returnRn decls1
 219         else
 220                 -- Yes, there are some, so rename them and loop
 221              traceRn (sep [ptext SLIT("Slurped"), int (length inst_decls), ptext SLIT("instance decls")])
 222                                                                 `thenRn_`
 223              mapRn (rn_inst_decl compulsory_mode) inst_decls    `thenRn` \ new_inst_decls ->
 224              slurp_compulsories (new_inst_decls ++ decls1)
 225 \end{code}
 226
 227 \begin{code}
 228 closeDecls :: RnSMode
 229            -> [RenamedHsDecl]                   -- Declarations got so far
 230            -> RnMG [RenamedHsDecl]              -- input + extra decls slurped
 231         -- The monad includes a list of possibly-unresolved Names
 232         -- This list is empty when closeDecls returns
 233
 234 closeDecls mode decls
 235   = popOccurrenceName mode              `thenRn` \ maybe_unresolved ->
 236     case maybe_unresolved of
 237
 238         -- No more unresolved names
 239         Nothing -> returnRn decls
 240
 241         -- An unresolved name
 242         Just name_w_loc
 243           ->    -- Slurp its declaration, if any
 244 --           traceRn (sep [ptext SLIT("Considering"), ppr name_w_loc])  `thenRn_`
 245              importDecl name_w_loc mode         `thenRn` \ maybe_decl ->
 246              case maybe_decl of
 247
 248                 -- No declaration... (wired in thing or optional)
 249                 Nothing   -> closeDecls mode decls
 250
 251                 -- Found a declaration... rename it
 252                 Just decl -> rn_iface_decl mod_name mode decl   `thenRn` \ new_decl ->
 253                              closeDecls mode (new_decl : decls)
 254                          where
 255                            mod_name = nameModule (fst name_w_loc)
 256
 257 rn_iface_decl mod_name mode decl
 258   = initRnMS emptyRnEnv mod_name mode (rnDecl decl)
 259
 260 rn_inst_decl mode (mod_name,decl)      = rn_iface_decl mod_name mode (InstD decl)
 261 rn_data_decl mode (tycon_name,ty_decl) = rn_iface_decl mod_name mode (TyD ty_decl)
 262                                        where
 263                                          mod_name = nameModule tycon_name
 264 \end{code}
 265
 266 \begin{code}
 267 reportUnusedNames (ExportEnv export_avails _) explicit_info
 268   | not (opt_WarnUnusedBinds || opt_WarnUnusedImports)
 269   = returnRn ()
 270
 271   | otherwise
 272   = getSlurpedNames                     `thenRn` \ slurped_names ->
 273     let
 274         unused_info :: FiniteMap Name HowInScope
 275         unused_info = foldl delListFromFM
 276                             (delListFromFM explicit_info (nameSetToList slurped_names))
 277                             (map availNames export_avails)
 278         unused_list = fmToList unused_info
 279
 280         groups = filter wanted (equivClasses cmp unused_list)
 281                where
 282                  (name1, his1) `cmp` (name2, his2) = his1 `cmph` his2
 283
 284                  (FromLocalDefn _)     `cmph` (FromImportDecl _ _)  = LT
 285                  (FromLocalDefn _)     `cmph` (FromLocalDefn _)     = EQ
 286                  (FromImportDecl m1 _) `cmph` (FromImportDecl m2 _) = m1 `compare` m2
 287                  h1                    `cmph` h2                    = GT
 288
 289         wanted ((_,FromImportDecl _ _) : _) = opt_WarnUnusedImports
 290         wanted ((_,FromLocalDefn _)    : _) = opt_WarnUnusedImports
 291
 292         pp_imp = sep [text "Warning: the following are unused:",
 293                       nest 4 (vcat (map pp_group groups))]
 294
 295         pp_group group = sep [msg <> char ':',
 296                               nest 4 (sep (map (pprOccName . nameOccName . fst) group))]
 297                        where
 298                          his = case group of
 299                                   ((_,his) : _) -> his
 300
 301                          msg = case his of
 302                                   FromImportDecl m _ -> text "Imported from" <+> pprModule m
 303                                   FromLocalDefn _    -> text "Locally defined"
 304
 305     in
 306     if null groups
 307     then returnRn ()
 308     else addWarnRn pp_imp
 309
 310 rnStats :: [RenamedHsDecl] -> RnMG ()
 311 rnStats all_decls
 312         | opt_D_show_rn_trace ||
 313           opt_D_show_rn_stats ||
 314           opt_D_dump_rn
 315         = getRnStats all_decls          `thenRn` \ msg ->
 316           ioToRnMG (printErrs msg)      `thenRn_`
 317           returnRn ()
 318
 319         | otherwise = returnRn ()
 320 \end{code}
 321