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.
emptyNameEnv, unitNameEnv, nameEnvElts,
extendNameEnv_C, extendNameEnv, foldNameEnv, filterNameEnv,
plusNameEnv, plusNameEnv_C, extendNameEnv, extendNameEnvList,
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"
) where
#include "HsVersions.h"
plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
extendNameEnvList:: NameEnv a -> [(Name,a)] -> NameEnv a
delFromNameEnv :: NameEnv a -> Name -> 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
elemNameEnv :: Name -> NameEnv a -> Bool
unitNameEnv :: Name -> a -> NameEnv a
lookupNameEnv :: NameEnv a -> Name -> Maybe a
plusNameEnv_C = plusUFM_C
extendNameEnvList= addListToUFM
delFromNameEnv = delFromUFM
plusNameEnv_C = plusUFM_C
extendNameEnvList= addListToUFM
delFromNameEnv = delFromUFM
+delListFromNameEnv = delListFromUFM
elemNameEnv = elemUFM
mapNameEnv = mapUFM
unitNameEnv = unitUFM
elemNameEnv = elemUFM
mapNameEnv = mapUFM
unitNameEnv = unitUFM
unload,
PersistentLinkerState{-abstractly!-}, emptyPLS,
#ifdef GHCI
unload,
PersistentLinkerState{-abstractly!-}, emptyPLS,
#ifdef GHCI
+ delListFromClosureEnv,
+ addListToClosureEnv,
-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
-> IO PersistentLinkerState
-updateClosureEnv pls new_bindings
+addListToClosureEnv pls new_bindings
= return pls{ closure_env = addListToFM (closure_env pls) new_bindings }
#endif
= return pls{ closure_env = addListToFM (closure_env pls) new_bindings }
#endif
import HscTypes
import RnEnv ( unQualInScope )
import Id ( idType, idName )
import HscTypes
import RnEnv ( unQualInScope )
import Id ( idType, idName )
-import Name ( Name, NamedThing(..) )
+import Name ( Name, NamedThing(..), nameRdrName )
-import RdrName ( emptyRdrEnv )
+import RdrName ( lookupRdrEnv, emptyRdrEnv )
import Module ( Module, ModuleName, moduleName, isHomeModule,
mkModuleName, moduleNameUserString, moduleUserString )
import CmStaticInfo ( GhciMode(..) )
import Module ( Module, ModuleName, moduleName, isHomeModule,
mkModuleName, moduleNameUserString, moduleUserString )
import CmStaticInfo ( GhciMode(..) )
-- update the interactive context
let
-- update the interactive context
let
- new_rn_env = extendLocalRdrEnv rn_env (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,
[ (getName id, AnId id) | id <- ids]
new_ic = icontext { ic_rn_env = new_rn_env,
let thing_to_run = unsafeCoerce# hval :: IO [HValue]
hvals <- thing_to_run
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
return (cmstate{ pcs=new_pcs, pls=new_pls, ic=new_ic }, names)
where
This *local* name is used by the interactive stuff
\begin{code}
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
\begin{code}
assertIdKey = mkPreludeMiscIdUnique 121
runSTRepIdKey = mkPreludeMiscIdUnique 122
\begin{code}
assertIdKey = mkPreludeMiscIdUnique 121
runSTRepIdKey = mkPreludeMiscIdUnique 122
-itIdKey = mkPreludeMiscIdUnique 123 -- "it" for the interactive interface
tcUserStmt names (ExprStmt expr loc)
= ASSERT( null names )
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_`
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_`
( 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]
tcUserStmt names stmt
= tc_stmts names [stmt]