Commit 183bd266 authored by simonmar's avatar simonmar
Browse files

[project @ 2001-01-18 16:30:00 by simonmar]

Problem 1
=========

The typechecker, when deciding whether to extend the Package
environment with any new typechecked declarations in its hand, was
inserting new declarations into the environment only if the
declaration's module differed from the "current" module.  This doesn't
work if the "current" module is a package module, as it could be at
the GHCi command line, for example.

The solution is to filter the declarations only if the current module
is not a package module.


Problem 2
=========

The "current" module, as obtained from the compilation manager, was
always bogusly a Home module (it used mkHomeModule).  To properly fix
this, the GHCi state has to carry around Modules instead of
ModuleNames, and CompMan.cmLoadModule needs to return a list of
Modules.
parent 54ecd8a2
......@@ -18,7 +18,7 @@ import CmLink
import CmTypes
import HscTypes
import Module ( Module, ModuleName, moduleName, isHomeModule,
mkHomeModule, mkModuleName, moduleNameUserString )
mkModuleName, moduleNameUserString )
import CmStaticInfo ( GhciMode(..) )
import DriverPipeline
import GetImports
......@@ -68,13 +68,13 @@ cmInit gmode
#ifdef GHCI
cmGetExpr :: CmState
-> DynFlags
-> ModuleName
-> Module
-> String
-> Bool
-> IO (CmState, Maybe (HValue, PrintUnqualified, Type))
cmGetExpr cmstate dflags modname expr wrap_print
cmGetExpr cmstate dflags mod expr wrap_print
= do (new_pcs, maybe_stuff) <-
hscExpr dflags hst hit pcs (mkHomeModule modname) expr wrap_print
hscExpr dflags hst hit pcs mod expr wrap_print
case maybe_stuff of
Nothing -> return (cmstate{ pcs=new_pcs }, Nothing)
Just (bcos, print_unqual, ty) -> do
......@@ -170,7 +170,7 @@ cmLoadModule :: CmState
-> FilePath
-> IO (CmState, -- new state
Bool, -- was successful
[ModuleName]) -- list of modules loaded
[Module]) -- list of modules loaded
cmLoadModule cmstate1 rootname
= do -- version 1's are the original, before downsweep
......@@ -308,7 +308,7 @@ cmLoadModule cmstate1 rootname
let cmstate3
= CmState { pcms=pcms3, pcs=pcs3, pls=pls3 }
return (cmstate3, True,
map name_of_summary modsDone)
map ms_mod modsDone)
else
-- Tricky. We need to back out the effects of compiling any
......@@ -344,7 +344,7 @@ cmLoadModule cmstate1 rootname
let cmstate4
= CmState { pcms=pcms4, pcs=pcs3, pls=pls4 }
return (cmstate4, False,
mods_to_keep_names)
map ms_mod mods_to_keep)
......
-----------------------------------------------------------------------------
-- $Id: InteractiveUI.hs,v 1.28 2001/01/18 12:54:16 simonmar Exp $
-- $Id: InteractiveUI.hs,v 1.29 2001/01/18 16:30:00 simonmar Exp $
--
-- GHC Interactive User Interface
--
......@@ -16,6 +16,7 @@ import CmStaticInfo
import DriverFlags
import DriverState
import Linker
import Finder
import Module
import Outputable
import Util
......@@ -110,9 +111,13 @@ interactiveUI cmstate mod = do
#ifndef NO_READLINE
Readline.initialize
#endif
prel <- moduleNameToModule defaultCurrentModuleName
writeIORef defaultCurrentModule prel
let this_mod = case mods of
[] -> defaultCurrentModule
m:ms -> m
[] -> prel
m:ms -> m
(unGHCi uiLoop) GHCiState{ modules = mods,
current_module = this_mod,
......@@ -122,11 +127,12 @@ interactiveUI cmstate mod = do
last_expr = Nothing}
return ()
uiLoop :: GHCi ()
uiLoop = do
st <- getGHCiState
#ifndef NO_READLINE
l <- io (readline (moduleNameUserString (current_module st) ++ "> "))
l <- io (readline (moduleUserString (current_module st) ++ "> "))
#else
l_ok <- io (hGetLine stdin)
let l = Just l_ok
......@@ -230,9 +236,18 @@ setContext ""
= throwDyn (OtherError "syntax: `:m <module>'")
setContext m | not (isUpper (head m)) || not (all isAlphaNum (tail m))
= throwDyn (OtherError ("strange looking module name: `" ++ m ++ "'"))
setContext m
= do st <- getGHCiState
setGHCiState st{current_module = mkModuleName m}
setContext mn
= do m <- io (moduleNameToModule (mkModuleName mn))
st <- getGHCiState
setGHCiState st{current_module = m}
moduleNameToModule :: ModuleName -> IO Module
moduleNameToModule mn
= do maybe_stuff <- findModule mn
case maybe_stuff of
Nothing -> throwDyn (OtherError ("can't find module `"
++ moduleNameUserString mn ++ "'"))
Just (m,_) -> return m
changeDirectory :: String -> GHCi ()
changeDirectory d = io (setCurrentDirectory d)
......@@ -245,11 +260,13 @@ loadModule' path = do
cmstate1 <- io (cmUnload (cmstate state))
(cmstate2, ok, mods) <- io (cmLoadModule cmstate1 path)
def_mod <- io (readIORef defaultCurrentModule)
let new_state = state{
cmstate = cmstate2,
modules = mods,
current_module = case mods of
[] -> defaultCurrentModule
[] -> def_mod
xs -> head xs,
target = Just path
}
......@@ -258,7 +275,7 @@ loadModule' path = do
let mod_commas
| null mods = text "none."
| otherwise = hsep (
punctuate comma (map (text.moduleNameUserString) mods)) <> text "."
punctuate comma (map (text.moduleUserString) mods)) <> text "."
case ok of
False ->
io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
......@@ -272,11 +289,12 @@ reloadModule "" = do
Nothing -> io (putStr "no current target\n")
Just path
-> do (new_cmstate, ok, mods) <- io (cmLoadModule (cmstate state) path)
def_mod <- io (readIORef defaultCurrentModule)
setGHCiState
state{cmstate=new_cmstate,
modules = mods,
current_module = case mods of
[] -> defaultCurrentModule
[] -> def_mod
xs -> head xs
}
......@@ -432,8 +450,8 @@ rememberExpr str
data GHCiState = GHCiState
{
modules :: [ModuleName],
current_module :: ModuleName,
modules :: [Module],
current_module :: Module,
target :: Maybe FilePath,
cmstate :: CmState,
options :: [GHCiOption],
......@@ -442,7 +460,8 @@ data GHCiState = GHCiState
data GHCiOption = ShowTiming | ShowType deriving Eq
defaultCurrentModule = mkModuleName "Prelude"
defaultCurrentModuleName = mkModuleName "Prelude"
GLOBAL_VAR(defaultCurrentModule, error "no defaultCurrentModule", Module)
newtype GHCi a = GHCi { unGHCi :: GHCiState -> IO (GHCiState, a) }
......
......@@ -42,10 +42,9 @@ import TcTyClsDecls ( tcTyAndClassDecls )
import CoreUnfold ( unfoldingTemplate, hasUnfolding )
import Type ( funResultTy, splitForAllTys, openTypeKind )
import Bag ( isEmptyBag )
import ErrUtils ( printErrorsAndWarnings, errorsFound, dumpIfSet_dyn, showPass )
import Id ( idType, idName, isLocalId, idUnfolding )
import Module ( Module )
import Module ( Module, isHomeModule )
import Name ( Name, toRdrName, isGlobalName )
import Name ( nameEnvElts, lookupNameEnv )
import TyCon ( tyConGenInfo )
......@@ -123,6 +122,8 @@ typecheckExpr dflags pcs hst unqual this_mod (expr, decls)
let all_expr = mkHsLet binds expr' in
zonkExpr all_expr `thenNF_Tc` \ zonked_expr ->
zonkTcType ty `thenNF_Tc` \ zonked_ty ->
ioToTc (dumpIfSet_dyn dflags
Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
returnTc (new_pcs, zonked_expr, zonked_ty)
where
get_fixity :: Name -> Maybe Fixity
......@@ -307,7 +308,16 @@ tcImports pcs hst get_fixity this_mod decls
tcGetEnv `thenTc` \ unf_env ->
let
imported_things = filter (not . isLocalThing this_mod) (nameEnvElts (getTcGEnv unf_env))
all_things = nameEnvElts (getTcGEnv unf_env)
-- sometimes we're compiling in the context of a package module
-- (on the GHCi command line, for example). In this case, we
-- want to treat everything we pulled in as an imported thing.
imported_things
| isHomeModule this_mod
= filter (not . isLocalThing this_mod) all_things
| otherwise
= all_things
new_pte :: PackageTypeEnv
new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
......
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