From e99de9b8c107b8d91a3c5bf1cd7644be9eb5f5dc Mon Sep 17 00:00:00 2001 From: simonmar Date: Tue, 21 Aug 2001 14:35:37 +0000 Subject: [PATCH] [project @ 2001-08-21 14:35:37 by simonmar] Make local bindings work on the GHCi command line again. --- ghc/compiler/main/HscMain.lhs | 28 +++++++--------------------- ghc/compiler/rename/Rename.lhs | 33 ++++++++++++--------------------- ghc/compiler/rename/RnMonad.lhs | 6 ++++++ 3 files changed, 25 insertions(+), 42 deletions(-) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 2e38352..f1a57b6 100644 --- 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 --- 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 --- 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} %================ -- 1.7.10.4