[project @ 2002-01-07 12:25:09 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / Rename.lhs
index 265a34f..b092251 100644 (file)
@@ -4,7 +4,10 @@
 \section[Rename]{Renaming and dependency analysis passes}
 
 \begin{code}
-module Rename ( renameModule, renameStmt, closeIfaceDecls, checkOldIface ) where
+module Rename ( 
+       renameModule, renameStmt, renameRdrName, 
+       closeIfaceDecls, checkOldIface 
+  ) where
 
 #include "HsVersions.h"
 
@@ -31,11 +34,12 @@ import RnHiFiles    ( readIface, loadInterface,
                          loadExports, loadFixDecls, loadDeprecs,
                        )
 import RnEnv           ( availsToNameSet, mkIfaceGlobalRdrEnv,
-                         emptyAvailEnv, unitAvailEnv, availEnvElts, 
+                         unitAvailEnv, availEnvElts, availNames,
                          plusAvailEnv, groupAvails, warnUnusedImports, 
                          warnUnusedLocalBinds, warnUnusedModules, 
-                         lookupSrcName, getImplicitStmtFVs, getImplicitModuleFVs, rnSyntaxNames,
-                         newGlobalName, unQualInScope,, ubiquitousNames
+                         lookupSrcName, getImplicitStmtFVs, 
+                         getImplicitModuleFVs, newGlobalName, unQualInScope,
+                         ubiquitousNames, lookupOccRn
                        )
 import Module           ( Module, ModuleName, WhereFrom(..),
                          moduleNameUserString, moduleName,
@@ -45,7 +49,7 @@ import Name           ( Name, nameModule )
 import NameEnv
 import NameSet
 import RdrName         ( foldRdrEnv, isQual )
-import PrelNames       ( SyntaxMap, vanillaSyntaxMap, pRELUDE_Name )
+import PrelNames       ( pRELUDE_Name )
 import ErrUtils                ( dumpIfSet, dumpIfSet_dyn, showPass, 
                          printErrorsAndWarnings, errorsFound )
 import Bag             ( bagToList )
@@ -55,17 +59,7 @@ import FiniteMap     ( FiniteMap, fmToList, emptyFM, lookupFM,
 import Maybes          ( maybeToBool, catMaybes )
 import Outputable
 import IO              ( openFile, IOMode(..) )
-import HscTypes                ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable, 
-                         ModIface(..), WhatsImported(..), 
-                         VersionInfo(..), ImportVersion, IsExported,
-                         IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
-                         GlobalRdrEnv, GlobalRdrElt(..), pprGlobalRdrEnv,
-                         AvailEnv, GenAvailInfo(..), AvailInfo, 
-                         Provenance(..), ImportReason(..), initialVersionInfo,
-                         Deprecations(..),
-                         LocalRdrEnv
-                        )
-import CmStaticInfo    ( GhciMode(..) )
+import HscTypes                -- lots of it
 import List            ( partition, nub )
 \end{code}
 
@@ -74,7 +68,7 @@ import List           ( partition, nub )
 
 %*********************************************************
 %*                                                      *
-\subsection{The two main wrappers}
+\subsection{The main wrappers}
 %*                                                      *
 %*********************************************************
 
@@ -84,7 +78,7 @@ renameModule :: DynFlags
             -> PersistentCompilerState 
             -> Module -> RdrNameHsModule 
             -> IO (PersistentCompilerState, PrintUnqualified,
-                   Maybe (IsExported, ModIface, (SyntaxMap, [RenamedHsDecl])))
+                   Maybe (IsExported, ModIface, [RenamedHsDecl]))
        -- Nothing => some error occurred in the renamer
 
 renameModule dflags hit hst pcs this_module rdr_module
@@ -92,71 +86,129 @@ renameModule dflags hit hst pcs this_module rdr_module
     rename this_module rdr_module
 \end{code}
 
-
 \begin{code}
 renameStmt :: DynFlags
           -> HomeIfaceTable -> HomeSymbolTable
           -> PersistentCompilerState 
-          -> Module                    -- current context (scope to compile in)
           -> Module                    -- current module
-          -> LocalRdrEnv               -- current context (temp bindings)
+          -> InteractiveContext
           -> RdrNameStmt               -- parsed stmt
           -> IO ( PersistentCompilerState, 
                   PrintUnqualified,
-                  Maybe ([Name], (SyntaxMap, RenamedStmt, [RenamedHsDecl]))
+                  Maybe ([Name], (RenamedStmt, [RenamedHsDecl]))
                  )
 
-renameStmt dflags hit hst pcs scope_module this_module local_env stmt
+renameStmt dflags hit hst pcs this_module ic stmt
   = renameSource dflags hit hst pcs this_module $
+    extendTypeEnvRn (ic_type_env ic)           $ 
 
-       -- Load the interface for the context module, so 
-       -- that we can get its top-level lexical environment
-       -- Bale out if we fail to do this
-    loadInterface doc (moduleName scope_module) ImportByUser `thenRn` \ iface ->
-    let rdr_env       = mi_globals iface
-       print_unqual  = unQualInScope rdr_env
-    in 
-    checkErrsRn                                `thenRn` \ no_errs_so_far ->
-    if not no_errs_so_far then
-       returnRn (print_unqual, Nothing)
-    else
+       -- load the context module
+    loadContextModule (ic_module ic) $ \ (rdr_env, print_unqual) ->
 
-       -- Rename it
-    initRnMS rdr_env local_env emptyLocalFixityEnv CmdLineMode (
+       -- Rename the stmt
+    initRnMS rdr_env emptyAvailEnv (ic_rn_env ic) emptyLocalFixityEnv CmdLineMode (
        rnStmt stmt     $ \ stmt' ->
        returnRn (([], stmt'), emptyFVs)
-    )                                          `thenRn` \ ((binders, stmt), fvs) -> 
+    )                                  `thenRn` \ ((binders, stmt), fvs) -> 
 
        -- Bale out if we fail
-    checkErrsRn                                        `thenRn` \ no_errs_so_far ->
+    checkErrsRn                                `thenRn` \ no_errs_so_far ->
     if not no_errs_so_far then
-        doDump [] stmt [] `thenRn_` returnRn (print_unqual, Nothing)
+        doDump dflags [] stmt [] `thenRn_` returnRn (print_unqual, Nothing)
     else
 
        -- Add implicit free vars, and close decls
     getImplicitStmtFVs                                 `thenRn` \ implicit_fvs ->
-    let
-       filtered_fvs = fvs `delListFromNameSet` rdrEnvElts local_env 
-       source_fvs   = implicit_fvs `plusFV` filtered_fvs
-    in
-    slurpImpDecls source_fvs                   `thenRn` \ decls ->
-
-    doDump binders stmt decls  `thenRn_`
-    returnRn (print_unqual, Just (binders, (vanillaSyntaxMap, stmt, decls)))
+    slurpImpDecls (fvs `plusFV` implicit_fvs)  `thenRn` \ decls ->
+       -- NB: an earlier version deleted (rdrEnvElts local_env) from
+       --     the fvs.  But (a) that isn't necessary, because previously
+       --     bound things in the local_env will be in the TypeEnv, and 
+       --     the renamer doesn't re-slurp such things, and 
+       -- (b) it's WRONG to delete them. Consider in GHCi:
+       --        Mod> let x = e :: T
+       --        Mod> let y = x + 3
+       --     We need to pass 'x' among the fvs to slurpImpDecls, so that
+       --     the latter can see that T is a gate, and hence import the Num T 
+       --     instance decl.  (See the InTypEnv case in RnIfaces.slurpSourceRefs.)
+
+    doDump dflags binders stmt decls           `thenRn_`
+    returnRn (print_unqual, Just (binders, (stmt, decls)))
 
   where
-     doc = text "context for compiling expression"
-
-     doDump :: [Name] -> RenamedStmt -> [RenamedHsDecl] -> RnMG (Either IOError ())
-     doDump bndrs stmt decls
-       = getDOptsRn  `thenRn` \ dflags ->
-         ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:" 
+     doDump :: DynFlags -> [Name] -> RenamedStmt -> [RenamedHsDecl]
+        -> RnMG (Either IOError ())
+     doDump dflags bndrs stmt decls
+       = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:" 
                        (vcat [text "Binders:" <+> ppr bndrs,
                               ppr stmt, text "",
                               vcat (map ppr decls)]))
-\end{code}
 
 
+renameRdrName
+          :: DynFlags
+          -> HomeIfaceTable -> HomeSymbolTable
+          -> PersistentCompilerState 
+          -> Module                    -- current module
+          -> InteractiveContext
+          -> [RdrName]                 -- name to rename
+          -> IO ( PersistentCompilerState, 
+                  PrintUnqualified,
+                  Maybe ([Name], [RenamedHsDecl])
+                 )
+
+renameRdrName dflags hit hst pcs this_module ic rdr_names = 
+  renameSource dflags hit hst pcs this_module  $
+  extendTypeEnvRn (ic_type_env ic)             $ 
+  loadContextModule (ic_module ic) $ \ (rdr_env, print_unqual) ->
+
+  -- rename the rdr_name
+  initRnMS rdr_env emptyAvailEnv (ic_rn_env ic) emptyLocalFixityEnv CmdLineMode
+       (mapRn (tryRn.lookupOccRn) rdr_names)   `thenRn` \ maybe_names ->
+  let 
+       ok_names = [ a | Right a <- maybe_names ]
+  in
+  if null ok_names
+       then let errs = head [ e | Left e <- maybe_names ]
+            in setErrsRn errs            `thenRn_`
+               doDump dflags ok_names [] `thenRn_` 
+               returnRn (print_unqual, Nothing)
+       else 
+
+  slurpImpDecls (mkNameSet ok_names)   `thenRn` \ decls ->
+
+  doDump dflags ok_names decls                 `thenRn_`
+  returnRn (print_unqual, Just (ok_names, decls))
+ where
+     doDump :: DynFlags -> [Name] -> [RenamedHsDecl] -> RnMG (Either IOError ())
+     doDump dflags names decls
+       = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:" 
+                       (vcat [ppr names, text "",
+                              vcat (map ppr decls)]))
+
+
+-- Load the interface for the context module, so 
+-- that we can get its top-level lexical environment
+-- Bale out if we fail to do this
+loadContextModule scope_module thing_inside
+  = let doc = text "context for compiling expression"
+    in
+    loadInterface doc (moduleName scope_module) ImportByUser `thenRn` \ iface ->
+
+       -- If this is a module we previously compiled, then mi_globals will
+       -- have its top-level environment.  If it is an imported module, then
+       -- we must invent a top-level environment from its exports.
+    let rdr_env | Just env <- mi_globals iface = env
+               | otherwise = mkIfaceGlobalRdrEnv (mi_exports iface)
+                         
+       print_unqual  = unQualInScope rdr_env
+    in 
+    checkErrsRn                                `thenRn` \ no_errs_so_far ->
+    if not no_errs_so_far then
+       returnRn (print_unqual, Nothing)
+    else
+       thing_inside (rdr_env, print_unqual)
+\end{code}
+
 %*********************************************************
 %*                                                      *
 \subsection{The main function: rename}
@@ -192,14 +244,30 @@ renameSource dflags hit hst old_pcs this_module thing_inside
 
 \begin{code}
 rename :: Module -> RdrNameHsModule 
-       -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, (SyntaxMap, [RenamedHsDecl])))
+       -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, [RenamedHsDecl]))
 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
   = pushSrcLocRn loc           $
 
        -- FIND THE GLOBAL NAME ENVIRONMENT
-    getGlobalNames this_module contents        `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
+    getGlobalNames this_module contents                `thenRn` \ (gbl_env, local_gbl_env, 
+                                                           (mod_avail_env, global_avail_env)) ->
     let
        print_unqualified = unQualInScope gbl_env
+
+       full_avail_env :: NameEnv AvailInfo
+               -- The domain of global_avail_env is just the 'major' things;
+               -- variables, type constructors, classes.  
+               --      E.g. Functor |-> Functor( Functor, fmap )
+               -- The domain of full_avail_env is everything in scope
+               --      E.g. Functor |-> Functor( Functor, fmap )
+               --           fmap    |-> Functor( Functor, fmap )
+               -- 
+               -- This filled-out avail_env is needed to generate
+               -- exports (mkExportAvails), and for generating minimal
+               -- exports (reportUnusedNames)
+       full_avail_env = mkNameEnv [ (name,avail) 
+                                  | avail <- availEnvElts global_avail_env,
+                                    name  <- availNames avail]
     in
        -- Exit if we've found any errors
     checkErrsRn                                `thenRn` \ no_errs_so_far ->
@@ -210,7 +278,8 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec
     else
        
        -- PROCESS EXPORT LIST 
-    exportsFromAvail mod_name exports all_avails gbl_env       `thenRn` \ export_avails ->
+    exportsFromAvail mod_name exports mod_avail_env 
+                    full_avail_env gbl_env             `thenRn` \ export_avails ->
        
     traceRn (text "Local top-level environment" $$ 
             nest 4 (pprGlobalRdrEnv local_gbl_env))    `thenRn_`
@@ -223,7 +292,8 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec
     fixitiesFromLocalDecls local_gbl_env local_decls   `thenRn` \ local_fixity_env ->
 
        -- RENAME THE SOURCE
-    rnSourceDecls gbl_env local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
+    rnSourceDecls gbl_env global_avail_env 
+                 local_fixity_env local_decls          `thenRn` \ (rn_local_decls, source_fvs) ->
 
        -- EXIT IF ERRORS FOUND
        -- We exit here if there are any errors in the source, *before*
@@ -240,10 +310,9 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec
        -- SLURP IN ALL THE NEEDED DECLARATIONS
        -- Find out what re-bindable names to use for desugaring
     getImplicitModuleFVs mod_name rn_local_decls       `thenRn` \ implicit_fvs ->
-    rnSyntaxNames gbl_env source_fvs                   `thenRn` \ (source_fvs1, sugar_map) ->
     let
        export_fvs  = availsToNameSet export_avails
-       source_fvs2 = source_fvs1 `plusFV` export_fvs
+       source_fvs2 = source_fvs `plusFV` export_fvs
                -- The export_fvs make the exported names look just as if they
                -- occurred in the source program.  For the reasoning, see the
                -- comments with RnIfaces.mkImportInfo
@@ -282,7 +351,7 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec
                                mi_boot     = False,
                                mi_orphan   = panic "is_orphan",
                                mi_exports  = my_exports,
-                               mi_globals  = gbl_env,
+                               mi_globals  = Just gbl_env,
                                mi_fixities = fixities,
                                mi_deprecs  = my_deprecs,
                                mi_decls    = panic "mi_decls"
@@ -294,12 +363,12 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec
 
        -- REPORT UNUSED NAMES, AND DEBUG DUMP 
     reportUnusedNames mod_iface print_unqualified 
-                     imports global_avail_env
+                     imports full_avail_env gbl_env
                      source_fvs2 rn_imp_decls          `thenRn_`
                -- NB: source_fvs2: include exports (else we get bogus 
                --     warnings of unused things) but not implicit FVs.
 
-    returnRn (print_unqualified, Just (is_exported, mod_iface, (sugar_map, final_decls)))
+    returnRn (print_unqualified, Just (is_exported, mod_iface, final_decls))
   where
     mod_name = moduleName this_module
 \end{code}
@@ -413,7 +482,9 @@ checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_ifa
           -> readIface iface_path      `thenRn` \ read_result ->
              case read_result of
                Left err -> -- Old interface file not found, or garbled; give up
-                          traceRn (text "Bad old interface file" $$ nest 4 err) `thenRn_`
+                          traceHiDiffsRn (
+                               text "Cannot read old interface file:"
+                                  $$ nest 4 err) `thenRn_`
                           returnRn (outOfDate, Nothing)
 
                Right parsed_iface
@@ -466,7 +537,7 @@ loadOldIface parsed_iface
                               mi_boot = False, mi_orphan = pi_orphan iface, 
                               mi_fixities = fix_env, mi_deprecs = deprec_env,
                               mi_decls   = decls,
-                              mi_globals = mkIfaceGlobalRdrEnv avails
+                              mi_globals = Nothing
                    }
     in
     returnRn mod_iface
@@ -569,10 +640,11 @@ closeIfaceDecls dflags hit hst pcs
 reportUnusedNames :: ModIface -> PrintUnqualified
                  -> [RdrNameImportDecl] 
                  -> AvailEnv
+                 -> GlobalRdrEnv
                  -> NameSet            -- Used in this module
                  -> [RenamedHsDecl] 
                  -> RnMG ()
-reportUnusedNames my_mod_iface unqual imports avail_env 
+reportUnusedNames my_mod_iface unqual imports avail_env gbl_env
                  used_names imported_decls
   = warnUnusedModules unused_imp_mods                          `thenRn_`
     warnUnusedLocalBinds bad_locals                            `thenRn_`
@@ -580,7 +652,6 @@ reportUnusedNames my_mod_iface unqual imports avail_env
     printMinimalImports this_mod unqual minimal_imports
   where
     this_mod   = mi_module my_mod_iface
-    gbl_env    = mi_globals my_mod_iface
     
     -- Now, a use of C implies a use of T,
     -- if C was brought into scope by T(..) or T(C)
@@ -688,8 +759,7 @@ printMinimalImports :: Module       -- This module
                    -> FiniteMap ModuleName AvailEnv    -- Minimal imports
                    -> RnMG ()
 printMinimalImports this_mod unqual imps
-  = doptRn Opt_D_dump_minimal_imports          `thenRn` \ dump_minimal ->
-    if not dump_minimal then returnRn () else
+  = ifOptRn Opt_D_dump_minimal_imports                 $
 
     mapRn to_ies (fmToList imps)               `thenRn` \ mod_ies ->
     ioToRnM (do { h <- openFile filename WriteMode ;
@@ -716,7 +786,8 @@ printMinimalImports this_mod unqual imps
     to_ie (AvailTC n [m]) = ASSERT( n==m ) 
                            returnRn (IEThingAbs n)
     to_ie (AvailTC n ns)  
-       = loadInterface (text "Compute minimal imports from" <+> ppr n_mod) n_mod ImportBySystem        `thenRn` \ iface ->
+       = loadInterface (text "Compute minimal imports from" <+> ppr n_mod) 
+                       n_mod ImportBySystem                            `thenRn` \ iface ->
          case [xs | (m,as) <- mi_exports iface,
                     m == n_mod,
                     AvailTC x xs <- as,