import CmTypes
import HscTypes
import Module ( Module, ModuleName, moduleName, isHomeModule,
- mkHomeModule, mkModuleName, moduleNameUserString )
+ mkModuleName, moduleNameUserString )
import CmStaticInfo ( GhciMode(..) )
import DriverPipeline
import GetImports
#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
-> 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
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
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
--
import DriverFlags
import DriverState
import Linker
+import Finder
import Module
import Outputable
import Util
#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,
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
= 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)
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
}
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)))
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
}
data GHCiState = GHCiState
{
- modules :: [ModuleName],
- current_module :: ModuleName,
+ modules :: [Module],
+ current_module :: Module,
target :: Maybe FilePath,
cmstate :: CmState,
options :: [GHCiOption],
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) }
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 )
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
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
projects / ghc-hetmet.git / commitdiff