[project @ 2001-11-05 14:16:48 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / Rename.lhs
index de1e0be..49a4c8a 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"
 
@@ -34,8 +37,9 @@ import RnEnv          ( availsToNameSet, mkIfaceGlobalRdrEnv,
                          emptyAvailEnv, unitAvailEnv, availEnvElts, 
                          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,123 @@ 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 (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 (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 ->
+    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
+       thing_inside (rdr_env, print_unqual)
+\end{code}
+
 %*********************************************************
 %*                                                      *
 \subsection{The main function: rename}
@@ -192,7 +238,7 @@ 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           $
 
@@ -240,10 +286,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
@@ -299,7 +344,7 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec
                -- 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 +458,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