Commit dd4bc7ed authored by simonmar's avatar simonmar
Browse files

[project @ 2001-03-19 16:22:00 by simonmar]

Fix a problem with the 'it' variable in GHCi.  New bindings for 'it'
were getting confused with old bindings, because we always used the
same 'it' name.

Now, we generate a new unique for 'it' each time around.

Also, make sure that any existing variables shadowed by new
command-line bindings are correctly removed from the environments to
avoid space leaks.
parent 4fb9c8aa
......@@ -9,7 +9,8 @@ module NameEnv (
emptyNameEnv, unitNameEnv, nameEnvElts,
extendNameEnv_C, extendNameEnv, foldNameEnv, filterNameEnv,
plusNameEnv, plusNameEnv_C, extendNameEnv, extendNameEnvList,
lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, elemNameEnv
lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
elemNameEnv
) where
#include "HsVersions.h"
......@@ -37,6 +38,7 @@ plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
extendNameEnvList:: NameEnv a -> [(Name,a)] -> NameEnv a
delFromNameEnv :: NameEnv a -> Name -> NameEnv a
delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
elemNameEnv :: Name -> NameEnv a -> Bool
unitNameEnv :: Name -> a -> NameEnv a
lookupNameEnv :: NameEnv a -> Name -> Maybe a
......@@ -55,6 +57,7 @@ plusNameEnv = plusUFM
plusNameEnv_C = plusUFM_C
extendNameEnvList= addListToUFM
delFromNameEnv = delFromUFM
delListFromNameEnv = delListFromUFM
elemNameEnv = elemUFM
mapNameEnv = mapUFM
unitNameEnv = unitUFM
......
......@@ -12,7 +12,8 @@ module CmLink ( Linkable(..), Unlinked(..),
unload,
PersistentLinkerState{-abstractly!-}, emptyPLS,
#ifdef GHCI
updateClosureEnv,
delListFromClosureEnv,
addListToClosureEnv,
linkExpr
#endif
) where
......@@ -95,9 +96,14 @@ emptyPLS = return (PersistentLinkerState {})
#endif
#ifdef GHCI
updateClosureEnv :: PersistentLinkerState -> [(Name,HValue)]
delListFromClosureEnv :: PersistentLinkerState -> [Name]
-> IO PersistentLinkerState
delListFromClosureEnv pls names
= return pls{ closure_env = delListFromFM (closure_env pls) names }
addListToClosureEnv :: PersistentLinkerState -> [(Name,HValue)]
-> IO PersistentLinkerState
updateClosureEnv pls new_bindings
addListToClosureEnv pls new_bindings
= return pls{ closure_env = addListToFM (closure_env pls) new_bindings }
#endif
......
......@@ -37,9 +37,9 @@ import CmTypes
import HscTypes
import RnEnv ( unQualInScope )
import Id ( idType, idName )
import Name ( Name, NamedThing(..) )
import Name ( Name, NamedThing(..), nameRdrName )
import NameEnv
import RdrName ( emptyRdrEnv )
import RdrName ( lookupRdrEnv, emptyRdrEnv )
import Module ( Module, ModuleName, moduleName, isHomeModule,
mkModuleName, moduleNameUserString, moduleUserString )
import CmStaticInfo ( GhciMode(..) )
......@@ -194,12 +194,18 @@ cmRunStmt cmstate dflags expr
-- update the interactive context
let
new_rn_env = extendLocalRdrEnv rn_env (map idName ids)
names = map idName ids
-- Extend the renamer-env from bound_ids, not
-- bound_names, because the latter may contain
-- [it] when the former is empty
new_type_env = extendNameEnvList type_env
-- these names have just been shadowed
shadowed = [ n | r <- map nameRdrName names,
Just n <- [lookupRdrEnv rn_env r] ]
new_rn_env = extendLocalRdrEnv rn_env names
-- remove any shadowed bindings from the type_env
filtered_type_env = delListFromNameEnv type_env shadowed
new_type_env = extendNameEnvList filtered_type_env
[ (getName id, AnId id) | id <- ids]
new_ic = icontext { ic_rn_env = new_rn_env,
......@@ -212,9 +218,11 @@ cmRunStmt cmstate dflags expr
let thing_to_run = unsafeCoerce# hval :: IO [HValue]
hvals <- thing_to_run
-- get the newly bound things, and bind them
let names = map idName ids
new_pls <- updateClosureEnv pls (zip names hvals)
-- Get the newly bound things, and bind them. Don't forget
-- to delete any shadowed bindings from the closure_env, lest
-- we end up with a space leak.
pls <- delListFromClosureEnv pls shadowed
new_pls <- addListToClosureEnv pls (zip names hvals)
return (cmstate{ pcs=new_pcs, pls=new_pls, ic=new_ic }, names)
where
......
......@@ -67,7 +67,7 @@ import Panic ( panic )
This *local* name is used by the interactive stuff
\begin{code}
itName = mkLocalName itIdKey (mkOccFS varName SLIT("it")) noSrcLoc
itName uniq = mkLocalName uniq (mkOccFS varName SLIT("it")) noSrcLoc
\end{code}
\begin{code}
......@@ -864,7 +864,6 @@ mapIdKey = mkPreludeMiscIdUnique 120
\begin{code}
assertIdKey = mkPreludeMiscIdUnique 121
runSTRepIdKey = mkPreludeMiscIdUnique 122
itIdKey = mkPreludeMiscIdUnique 123 -- "it" for the interactive interface
\end{code}
......
......@@ -159,13 +159,18 @@ tcUserStmt :: [Name] -> RenamedStmt -> TcM (TypecheckedHsExpr, [Id])
tcUserStmt names (ExprStmt expr loc)
= ASSERT( null names )
tcGetUnique `thenNF_Tc` \ uniq ->
let
fresh_it = itName uniq
the_bind = FunMonoBind fresh_it False
[ mkSimpleMatch [] expr Nothing loc ] loc
in
tryTc_ (traceTc (text "tcs 1b") `thenNF_Tc_`
tc_stmts [itName] [LetStmt (MonoBind the_bind [] NonRecursive),
ExprStmt (HsApp (HsVar printName) (HsVar itName)) loc])
tc_stmts [fresh_it] [
LetStmt (MonoBind the_bind [] NonRecursive),
ExprStmt (HsApp (HsVar printName) (HsVar fresh_it)) loc])
( traceTc (text "tcs 1a") `thenNF_Tc_`
tc_stmts [itName] [BindStmt (VarPatIn itName) expr loc])
where
the_bind = FunMonoBind itName False [mkSimpleMatch [] expr Nothing loc] loc
tc_stmts [fresh_it] [BindStmt (VarPatIn fresh_it) expr loc])
tcUserStmt names stmt
= tc_stmts names [stmt]
......
Markdown is supported
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