Commit e99de9b8 authored by simonmar's avatar simonmar
Browse files

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

Make local bindings work on the GHCi command line again.
parent dd8ab37f
......@@ -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, []);
......
......@@ -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 ]
......
......@@ -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}
%================
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment