[project @ 2001-08-21 14:35:37 by simonmar]

Make local bindings work on the GHCi command line again.

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 2e38352..f1a57b6 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -29,8 +29,6 @@ import HscTypes               ( InteractiveContext(..) )
 import PrelNames       ( iNTERACTIVE )
 import StringBuffer    ( stringToStringBuffer )
 import FastString       ( mkFastString )
-import Char            ( isUpper )
-import DriverUtil      ( split_longest_prefix )
 #endif
 
 import HsSyn
@@ -499,13 +497,7 @@ A naked expression returns a singleton Name [it].
 
 \begin{code}
 hscStmt dflags hst hit pcs0 icontext stmt just_expr
-   = let 
-       InteractiveContext { 
-            ic_rn_env   = rn_env, 
-            ic_type_env = type_env,
-            ic_module   = scope_mod } = icontext
-     in
-     do { maybe_stmt <- hscParseStmt dflags stmt
+   =  do { maybe_stmt <- hscParseStmt dflags stmt
        ; case maybe_stmt of
             Nothing -> return (pcs0, Nothing)
             Just parsed_stmt -> do {
@@ -521,8 +513,8 @@ hscStmt dflags hst hit pcs0 icontext stmt just_expr
 
                -- Rename it
          (pcs1, print_unqual, maybe_renamed_stmt)
-                <- renameStmt dflags hit hst pcs0 scope_mod 
-                               iNTERACTIVE rn_env parsed_stmt
+                <- renameStmt dflags hit hst pcs0 
+                       iNTERACTIVE icontext parsed_stmt
 
        ; case maybe_renamed_stmt of
                Nothing -> return (pcs0, Nothing)
@@ -532,9 +524,9 @@ hscStmt dflags hst hit pcs0 icontext stmt just_expr
          maybe_tc_return <- 
            if just_expr 
                then case rn_stmt of { (ExprStmt e _ _, decls) -> 
-                    typecheckExpr dflags pcs1 hst type_env
+                    typecheckExpr dflags pcs1 hst (ic_type_env icontext)
                           print_unqual iNTERACTIVE (e,decls) }
-               else typecheckStmt dflags pcs1 hst type_env
+               else typecheckStmt dflags pcs1 hst (ic_type_env icontext)
                           print_unqual iNTERACTIVE bound_names rn_stmt
 
        ; case maybe_tc_return of
@@ -621,12 +613,7 @@ hscThing -- like hscStmt, but deals with a single identifier
          [TyThing] )
 
 hscThing dflags hst hit pcs0 icontext str
-   = do let 
-         InteractiveContext {
-            ic_rn_env   = rn_env,
-            ic_module   = scope_mod } = icontext
-
-       maybe_rdr_name <- myParseIdentifier dflags str
+   = do maybe_rdr_name <- myParseIdentifier dflags str
        case maybe_rdr_name of {
          Nothing -> return (pcs0, []);
          Just rdr_name -> do
@@ -643,8 +630,7 @@ hscThing dflags hst hit pcs0 icontext str
                tccls_name = setRdrNameOcc rdr_name tccls_occ
 
        (pcs, unqual, maybe_rn_result) <- 
-          renameRdrName dflags hit hst pcs0 scope_mod scope_mod 
-               rn_env rdr_names
+          renameRdrName dflags hit hst pcs0 iNTERACTIVE icontext rdr_names
 
        case maybe_rn_result of {
             Nothing -> return (pcs, []);

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 53ed3a2..613ed08 100644 (file)
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -59,16 +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(..), GhciMode(..),
-                         LocalRdrEnv
-                        )
+import HscTypes                -- lots of it
 import List            ( partition, nub )
 \end{code}
 
@@ -99,23 +90,23 @@ renameModule dflags hit hst pcs this_module rdr_module
 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], (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 context module
-    loadContextModule scope_module $ \ (rdr_env, print_unqual) ->
+    loadContextModule (ic_module ic) $ \ (rdr_env, print_unqual) ->
 
        -- Rename the stmt
-    initRnMS rdr_env local_env emptyLocalFixityEnv CmdLineMode (
+    initRnMS rdr_env (ic_rn_env ic) emptyLocalFixityEnv CmdLineMode (
        rnStmt stmt     $ \ stmt' ->
        returnRn (([], stmt'), emptyFVs)
     )                                  `thenRn` \ ((binders, stmt), fvs) -> 
@@ -157,21 +148,21 @@ renameRdrName
           :: DynFlags
           -> HomeIfaceTable -> HomeSymbolTable
           -> PersistentCompilerState 
-          -> Module                    -- current context (scope to compile in)
           -> Module                    -- current module
-          -> LocalRdrEnv               -- current context (temp bindings)
+          -> InteractiveContext
           -> [RdrName]                 -- name to rename
           -> IO ( PersistentCompilerState, 
                   PrintUnqualified,
                   Maybe ([Name], [RenamedHsDecl])
                  )
 
-renameRdrName dflags hit hst pcs scope_module this_module local_env rdr_names = 
-  renameSource dflags hit hst pcs this_module $
-  loadContextModule scope_module $ \ (rdr_env, print_unqual) ->
+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 local_env emptyLocalFixityEnv CmdLineMode
+  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 ]

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 02327bf..90de0ee 100644 (file)
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -65,6 +65,7 @@ import CmdLineOpts    ( DynFlags, DynFlag(..), dopt )
 import SrcLoc          ( SrcLoc, generatedSrcLoc, noSrcLoc )
 import Unique          ( Unique )
 import FiniteMap       ( FiniteMap )
+import Maybes          ( seqMaybe )
 import Bag             ( Bag, emptyBag, isEmptyBag, snocBag )
 import UniqSupply
 import Outputable
@@ -624,6 +625,11 @@ getHomeIfaceTableRn down l_down = return (rn_hit down)
 
 getTypeEnvRn :: RnM d (Name -> Maybe TyThing)
 getTypeEnvRn down l_down = return (rn_done down)
+
+extendTypeEnvRn :: NameEnv TyThing -> RnM d a -> RnM d a
+extendTypeEnvRn env inside down l_down
+  = inside down{rn_done=new_rn_done} l_down
+  where new_rn_done = \nm -> lookupNameEnv env nm `seqMaybe` rn_done down nm
 \end{code}
 
 %================