Commit 1c62b517 authored by simonmar's avatar simonmar

[project @ 2001-02-26 15:06:57 by simonmar]

Implement do-style bindings on the GHCi command line.

The syntax for a command-line is exactly that of a do statement, with
the following meanings:

  - `pat <- expr'
    performs expr, and binds each of the variables in pat.

  - `let pat = expr; ...'
    binds each of the variables in pat, doesn't do any evaluation

  - `expr'
    behaves as `it <- expr' if expr is IO-typed, or `let it = expr'
    followed by `print it' otherwise.
parent 8d0e6c63
...@@ -16,7 +16,7 @@ module IdInfo ( ...@@ -16,7 +16,7 @@ module IdInfo (
zapFragileInfo, zapLamInfo, zapSpecPragInfo, shortableIdInfo, copyIdInfo, zapFragileInfo, zapLamInfo, zapSpecPragInfo, shortableIdInfo, copyIdInfo,
-- Flavour -- Flavour
IdFlavour(..), flavourInfo, IdFlavour(..), flavourInfo, makeConstantFlavour,
setNoDiscardInfo, setFlavourInfo, setNoDiscardInfo, setFlavourInfo,
ppFlavourInfo, ppFlavourInfo,
...@@ -267,6 +267,18 @@ data IdFlavour ...@@ -267,6 +267,18 @@ data IdFlavour
| RecordSelId FieldLabel -- The Id for a record selector | RecordSelId FieldLabel -- The Id for a record selector
makeConstantFlavour :: IdFlavour -> IdFlavour
makeConstantFlavour flavour = new_flavour
where new_flavour = case flavour of
VanillaId -> ConstantId
ExportedId -> ConstantId
ConstantId -> ConstantId -- e.g. Default methods
DictFunId -> DictFunId
flavour -> pprTrace "makeConstantFlavour"
(ppFlavourInfo flavour)
flavour
ppFlavourInfo :: IdFlavour -> SDoc ppFlavourInfo :: IdFlavour -> SDoc
ppFlavourInfo VanillaId = empty ppFlavourInfo VanillaId = empty
ppFlavourInfo ExportedId = ptext SLIT("[Exported]") ppFlavourInfo ExportedId = ptext SLIT("[Exported]")
......
...@@ -20,10 +20,11 @@ module Name ( ...@@ -20,10 +20,11 @@ module Name (
toRdrName, hashName, toRdrName, hashName,
globaliseName, localiseName, globaliseName, localiseName,
nameSrcLoc, nameIsLocallyDefined, isDllName, nameIsFrom, nameIsLocalOrFrom, nameSrcLoc,
isSystemName, isLocalName, isGlobalName, isExternallyVisibleName, isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
isTyVarName, isTyVarName, isDllName,
nameIsLocalOrFrom, isHomePackageName,
-- Environment -- Environment
NameEnv, mkNameEnv, NameEnv, mkNameEnv,
...@@ -35,8 +36,7 @@ module Name ( ...@@ -35,8 +36,7 @@ module Name (
-- Class NamedThing and overloaded friends -- Class NamedThing and overloaded friends
NamedThing(..), NamedThing(..),
getSrcLoc, getOccString, toRdrName, getSrcLoc, getOccString, toRdrName
isFrom, isLocalOrFrom
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -121,26 +121,29 @@ nameModule_maybe name = Nothing ...@@ -121,26 +121,29 @@ nameModule_maybe name = Nothing
\end{code} \end{code}
\begin{code} \begin{code}
nameIsLocallyDefined :: Name -> Bool
nameIsFrom :: Module -> Name -> Bool
nameIsLocalOrFrom :: Module -> Name -> Bool nameIsLocalOrFrom :: Module -> Name -> Bool
isLocalName :: Name -> Bool -- Not globals isLocalName :: Name -> Bool -- Not globals
isGlobalName :: Name -> Bool isGlobalName :: Name -> Bool
isSystemName :: Name -> Bool isSystemName :: Name -> Bool
isExternallyVisibleName :: Name -> Bool isExternallyVisibleName :: Name -> Bool
isHomePackageName :: Name -> Bool
isGlobalName (Name {n_sort = Global _}) = True isGlobalName (Name {n_sort = Global _}) = True
isGlobalName other = False isGlobalName other = False
isLocalName name = not (isGlobalName name) isLocalName name = not (isGlobalName name)
nameIsLocallyDefined name = isLocalName name
nameIsLocalOrFrom from (Name {n_sort = Global mod}) = mod == from nameIsLocalOrFrom from (Name {n_sort = Global mod}) = mod == from
nameIsLocalOrFrom from other = True nameIsLocalOrFrom from other = True
nameIsFrom from (Name {n_sort = Global mod}) = mod == from isHomePackageName (Name {n_sort = Global mod}) = isHomeModule mod
nameIsFrom from other = pprPanic "nameIsFrom" (ppr other) isHomePackageName other = True -- Local and system names
isDllName :: Name -> Bool -- Does this name refer to something in a different DLL?
isDllName nm = not opt_Static && not (isHomePackageName nm)
isTyVarName :: Name -> Bool
isTyVarName name = isTvOcc (nameOccName name)
-- Global names are by definition those that are visible -- Global names are by definition those that are visible
-- outside the module, *as seen by the linker*. Externally visible -- outside the module, *as seen by the linker*. Externally visible
...@@ -238,17 +241,6 @@ nameRdrName :: Name -> RdrName ...@@ -238,17 +241,6 @@ nameRdrName :: Name -> RdrName
-- and an unqualified name just for Locals -- and an unqualified name just for Locals
nameRdrName (Name { n_occ = occ, n_sort = Global mod }) = mkRdrOrig (moduleName mod) occ nameRdrName (Name { n_occ = occ, n_sort = Global mod }) = mkRdrOrig (moduleName mod) occ
nameRdrName (Name { n_occ = occ }) = mkRdrUnqual occ nameRdrName (Name { n_occ = occ }) = mkRdrUnqual occ
isDllName :: Name -> Bool
-- Does this name refer to something in a different DLL?
isDllName nm = not opt_Static &&
not (isLocalName nm) && -- isLocalName test needed 'cos
not (isHomeModule (nameModule nm)) -- nameModule won't work on local names
isTyVarName :: Name -> Bool
isTyVarName name = isTvOcc (nameOccName name)
\end{code} \end{code}
...@@ -390,13 +382,9 @@ class NamedThing a where ...@@ -390,13 +382,9 @@ class NamedThing a where
getSrcLoc :: NamedThing a => a -> SrcLoc getSrcLoc :: NamedThing a => a -> SrcLoc
getOccString :: NamedThing a => a -> String getOccString :: NamedThing a => a -> String
toRdrName :: NamedThing a => a -> RdrName toRdrName :: NamedThing a => a -> RdrName
isFrom :: NamedThing a => Module -> a -> Bool
isLocalOrFrom :: NamedThing a => Module -> a -> Bool
getSrcLoc = nameSrcLoc . getName getSrcLoc = nameSrcLoc . getName
getOccString = occNameString . getOccName getOccString = occNameString . getOccName
toRdrName = nameRdrName . getName toRdrName = nameRdrName . getName
isFrom mod x = nameIsFrom mod (getName x)
isLocalOrFrom mod x = nameIsLocalOrFrom mod ( getName x)
\end{code} \end{code}
...@@ -8,6 +8,7 @@ module CmLink ( Linkable(..), Unlinked(..), ...@@ -8,6 +8,7 @@ module CmLink ( Linkable(..), Unlinked(..),
filterModuleLinkables, filterModuleLinkables,
findModuleLinkable_maybe, findModuleLinkable_maybe,
LinkResult(..), LinkResult(..),
updateClosureEnv,
link, link,
unload, unload,
PersistentLinkerState{-abstractly!-}, emptyPLS, PersistentLinkerState{-abstractly!-}, emptyPLS,
...@@ -23,6 +24,7 @@ import CmTypes ...@@ -23,6 +24,7 @@ import CmTypes
import CmStaticInfo ( GhciMode(..) ) import CmStaticInfo ( GhciMode(..) )
import Outputable ( SDoc ) import Outputable ( SDoc )
import Digraph ( SCC(..), flattenSCC ) import Digraph ( SCC(..), flattenSCC )
import Name ( Name )
import Module ( ModuleName ) import Module ( ModuleName )
import FiniteMap import FiniteMap
import Outputable import Outputable
...@@ -88,6 +90,11 @@ emptyPLS = return (PersistentLinkerState { closure_env = emptyFM, ...@@ -88,6 +90,11 @@ emptyPLS = return (PersistentLinkerState { closure_env = emptyFM,
emptyPLS = return (PersistentLinkerState {}) emptyPLS = return (PersistentLinkerState {})
#endif #endif
updateClosureEnv :: PersistentLinkerState -> [(Name,HValue)]
-> IO PersistentLinkerState
updateClosureEnv pls new_bindings
= return pls{ closure_env = addListToFM (closure_env pls) new_bindings }
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Unloading old objects ready for a new compilation sweep. -- Unloading old objects ready for a new compilation sweep.
-- --
......
...@@ -4,12 +4,19 @@ ...@@ -4,12 +4,19 @@
\section[CompManager]{The Compilation Manager} \section[CompManager]{The Compilation Manager}
\begin{code} \begin{code}
module CompManager ( cmInit, cmLoadModule, cmUnload, module CompManager (
cmInit, -- :: GhciMode -> IO CmState
cmLoadModule, -- :: CmState -> FilePath -> IO (CmState, [String])
cmUnload, -- :: CmState -> IO CmState
cmTypeOfName, -- :: CmState -> Name -> IO (Maybe String)
cmSetContext, -- :: CmState -> String -> IO CmState
cmGetContext, -- :: CmState -> IO String
#ifdef GHCI #ifdef GHCI
cmGetExpr, cmRunExpr, cmRunStmt, -- :: CmState -> DynFlags -> String -> IO (CmState, [Name])
#endif #endif
CmState, emptyCmState -- abstract CmState, emptyCmState -- abstract
) )
where where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -17,16 +24,19 @@ where ...@@ -17,16 +24,19 @@ where
import CmLink import CmLink
import CmTypes import CmTypes
import HscTypes import HscTypes
import RnEnv ( unQualInScope )
import Id ( idType, idName )
import Name ( Name, lookupNameEnv )
import RdrName ( emptyRdrEnv )
import Module ( Module, ModuleName, moduleName, isHomeModule, import Module ( Module, ModuleName, moduleName, isHomeModule,
mkModuleName, moduleNameUserString ) mkModuleName, moduleNameUserString, moduleUserString )
import CmStaticInfo ( GhciMode(..) ) import CmStaticInfo ( GhciMode(..) )
import DriverPipeline import DriverPipeline
import GetImports import GetImports
import HscTypes ( HomeSymbolTable, HomeIfaceTable, import HscTypes
PersistentCompilerState, ModDetails(..) )
import HscMain ( initPersistentCompilerState ) import HscMain ( initPersistentCompilerState )
import Finder import Finder
import UniqFM ( emptyUFM, lookupUFM, addToUFM, delListFromUFM, import UniqFM ( lookupUFM, addToUFM, delListFromUFM,
UniqFM, listToUFM ) UniqFM, listToUFM )
import Unique ( Uniquable ) import Unique ( Uniquable )
import Digraph ( SCC(..), stronglyConnComp, flattenSCC ) import Digraph ( SCC(..), stronglyConnComp, flattenSCC )
...@@ -44,8 +54,7 @@ import IOExts ...@@ -44,8 +54,7 @@ import IOExts
#ifdef GHCI #ifdef GHCI
import Interpreter ( HValue ) import Interpreter ( HValue )
import HscMain ( hscExpr ) import HscMain ( hscStmt )
import Type ( Type )
import PrelGHC ( unsafeCoerce# ) import PrelGHC ( unsafeCoerce# )
#endif #endif
...@@ -63,43 +72,6 @@ import Maybe ( catMaybes, fromMaybe, isJust, fromJust ) ...@@ -63,43 +72,6 @@ import Maybe ( catMaybes, fromMaybe, isJust, fromJust )
\begin{code} \begin{code}
cmInit :: GhciMode -> IO CmState
cmInit gmode
= emptyCmState gmode
#ifdef GHCI
cmGetExpr :: CmState
-> DynFlags
-> Bool -- True <=> wrap in 'print' to get an IO-typed result
-> Module
-> String
-> IO (CmState, Maybe (HValue, PrintUnqualified, Type))
cmGetExpr cmstate dflags wrap_io mod expr
= do (new_pcs, maybe_stuff) <-
hscExpr dflags wrap_io hst hit pcs mod expr
case maybe_stuff of
Nothing -> return (cmstate{ pcs=new_pcs }, Nothing)
Just (bcos, print_unqual, ty) -> do
hValue <- linkExpr pls bcos
return (cmstate{ pcs=new_pcs },
Just (hValue, print_unqual, ty))
-- ToDo: check that the module we passed in is sane/exists?
where
CmState{ hst=hst, hit=hit, pcs=pcs, pls=pls } = cmstate
-- The HValue should represent a value of type IO () (Perhaps IO a?)
cmRunExpr :: HValue -> IO ()
cmRunExpr hval
= do unsafeCoerce# hval :: IO ()
-- putStrLn "done."
#endif
emptyHIT :: HomeIfaceTable
emptyHIT = emptyUFM
emptyHST :: HomeSymbolTable
emptyHST = emptyUFM
-- Persistent state for the entire system -- Persistent state for the entire system
data CmState data CmState
= CmState { = CmState {
...@@ -108,23 +80,33 @@ data CmState ...@@ -108,23 +80,33 @@ data CmState
ui :: UnlinkedImage, -- the unlinked images ui :: UnlinkedImage, -- the unlinked images
mg :: ModuleGraph, -- the module graph mg :: ModuleGraph, -- the module graph
gmode :: GhciMode, -- NEVER CHANGES gmode :: GhciMode, -- NEVER CHANGES
ic :: InteractiveContext, -- command-line binding info
pcs :: PersistentCompilerState, -- compile's persistent state pcs :: PersistentCompilerState, -- compile's persistent state
pls :: PersistentLinkerState -- link's persistent state pls :: PersistentLinkerState -- link's persistent state
} }
emptyCmState :: GhciMode -> IO CmState emptyCmState :: GhciMode -> Module -> IO CmState
emptyCmState gmode emptyCmState gmode mod
= do pcs <- initPersistentCompilerState = do pcs <- initPersistentCompilerState
pls <- emptyPLS pls <- emptyPLS
return (CmState { hst = emptyHST, return (CmState { hst = emptySymbolTable,
hit = emptyHIT, hit = emptyIfaceTable,
ui = emptyUI, ui = emptyUI,
mg = emptyMG, mg = emptyMG,
gmode = gmode, gmode = gmode,
ic = emptyInteractiveContext mod,
pcs = pcs, pcs = pcs,
pls = pls }) pls = pls })
emptyInteractiveContext mod
= InteractiveContext { ic_module = mod,
ic_rn_env = emptyRdrEnv,
ic_type_env = emptyTypeEnv }
defaultCurrentModuleName = mkModuleName "Prelude"
GLOBAL_VAR(defaultCurrentModule, error "no defaultCurrentModule", Module)
-- CM internal types -- CM internal types
type UnlinkedImage = [Linkable] -- the unlinked images (should be a set, really) type UnlinkedImage = [Linkable] -- the unlinked images (should be a set, really)
emptyUI :: UnlinkedImage emptyUI :: UnlinkedImage
...@@ -134,12 +116,106 @@ type ModuleGraph = [ModSummary] -- the module graph, topologically sorted ...@@ -134,12 +116,106 @@ type ModuleGraph = [ModSummary] -- the module graph, topologically sorted
emptyMG :: ModuleGraph emptyMG :: ModuleGraph
emptyMG = [] emptyMG = []
\end{code} -----------------------------------------------------------------------------
-- Produce an initial CmState.
cmInit :: GhciMode -> IO CmState
cmInit mode = do
prel <- moduleNameToModule defaultCurrentModuleName
writeIORef defaultCurrentModule prel
emptyCmState mode prel
Unload the compilation manager's state: everything it knows about the -----------------------------------------------------------------------------
current collection of modules in the Home package. -- Setting the context doesn't throw away any bindings; the bindings
-- we've built up in the InteractiveContext simply move to the new
-- module. They always shadow anything in scope in the current context.
cmSetContext :: CmState -> String -> IO CmState
cmSetContext cmstate str
= do let mn = mkModuleName str
modules_loaded = [ (name_of_summary s, ms_mod s) | s <- mg cmstate ]
m <- case lookup mn modules_loaded of
Just m -> return m
Nothing -> do
mod <- moduleNameToModule mn
if isHomeModule mod
then throwDyn (OtherError (showSDoc
(quotes (ppr (moduleName mod))
<+> text "is not currently loaded")))
else return mod
return cmstate{ ic = (ic cmstate){ic_module=m} }
cmGetContext :: CmState -> IO String
cmGetContext cmstate = return (moduleUserString (ic_module (ic cmstate)))
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
-----------------------------------------------------------------------------
-- cmRunStmt: Run a statement/expr.
#ifdef GHCI
cmRunStmt :: CmState -> DynFlags -> String -> IO (CmState, [Name])
cmRunStmt cmstate dflags expr
= do (new_pcs, maybe_stuff) <- hscStmt dflags hst hit pcs (ic cmstate) expr
case maybe_stuff of
Nothing -> return (cmstate{ pcs=new_pcs }, [])
Just (new_ic, ids, bcos) -> do
hval <- linkExpr pls bcos
hvals <- unsafeCoerce# hval :: IO [HValue]
let names = map idName ids
new_pls <- updateClosureEnv pls (zip names hvals)
return (cmstate{ pcs=new_pcs, pls=new_pls, ic=new_ic }, names)
-- ToDo: check that the module we passed in is sane/exists?
where
CmState{ hst=hst, hit=hit, pcs=pcs, pls=pls } = cmstate
#endif
-----------------------------------------------------------------------------
-- cmTypeOf: returns a string representing the type of a name.
cmTypeOfName :: CmState -> Name -> IO (Maybe String)
cmTypeOfName CmState{ hit=hit, pcs=pcs, ic=ic } name
= case lookupNameEnv (ic_type_env ic) name of
Nothing -> return Nothing
Just (AnId id) ->
let pit = pcs_PIT pcs
modname = moduleName (ic_module ic)
str = case lookupIfaceByModName hit pit modname of
Nothing -> showSDoc (ppr (idType id))
Just iface -> showSDocForUser unqual (ppr (idType id))
where unqual = unQualInScope (mi_globals iface)
in return (Just str)
_ -> panic "cmTypeOfName"
-----------------------------------------------------------------------------
-- cmInfo: return "info" about an expression. The info might be:
--
-- * its type, for an expression,
-- * the class definition, for a class
-- * the datatype definition, for a tycon (or synonym)
-- * the export list, for a module
--
-- Can be used to find the type of the last expression compiled, by looking
-- for "it".
cmInfo :: CmState -> String -> IO (Maybe String)
cmInfo cmstate str
= do error "cmInfo not implemented yet"
-----------------------------------------------------------------------------
-- Unload the compilation manager's state: everything it knows about the
-- current collection of modules in the Home package.
\begin{code}
cmUnload :: CmState -> IO CmState cmUnload :: CmState -> IO CmState
cmUnload state cmUnload state
= do -- Throw away the old home dir cache = do -- Throw away the old home dir cache
...@@ -149,18 +225,17 @@ cmUnload state ...@@ -149,18 +225,17 @@ cmUnload state
where where
CmState{ hst=hst, hit=hit } = state CmState{ hst=hst, hit=hit } = state
(new_hst, new_hit) = retainInTopLevelEnvs [] (hst,hit) (new_hst, new_hit) = retainInTopLevelEnvs [] (hst,hit)
\end{code}
The real business of the compilation manager: given a system state and -----------------------------------------------------------------------------
a module name, try and bring the module up to date, probably changing -- The real business of the compilation manager: given a system state and
the system state at the same time. -- a module name, try and bring the module up to date, probably changing
-- the system state at the same time.
\begin{code}
cmLoadModule :: CmState cmLoadModule :: CmState
-> FilePath -> FilePath
-> IO (CmState, -- new state -> IO (CmState, -- new state
Bool, -- was successful Bool, -- was successful
[Module]) -- list of modules loaded [String]) -- list of modules loaded
cmLoadModule cmstate1 rootname cmLoadModule cmstate1 rootname
= do -- version 1's are the original, before downsweep = do -- version 1's are the original, before downsweep
...@@ -172,6 +247,7 @@ cmLoadModule cmstate1 rootname ...@@ -172,6 +247,7 @@ cmLoadModule cmstate1 rootname
-- the previous pass, if any. -- the previous pass, if any.
let ui1 = ui cmstate1 let ui1 = ui cmstate1
let mg1 = mg cmstate1 let mg1 = mg cmstate1
let ic1 = ic cmstate1
let ghci_mode = gmode cmstate1 -- this never changes let ghci_mode = gmode cmstate1 -- this never changes
...@@ -228,7 +304,7 @@ cmLoadModule cmstate1 rootname ...@@ -228,7 +304,7 @@ cmLoadModule cmstate1 rootname
valid_linkables valid_linkables
when (verb >= 2) $ when (verb >= 2) $
putStrLn (showSDoc (text "STABLE MODULES:" putStrLn (showSDoc (text "Stable modules:"
<+> sep (map (text.moduleNameUserString) stable_mods))) <+> sep (map (text.moduleNameUserString) stable_mods)))
-- unload any modules which aren't going to be re-linked this -- unload any modules which aren't going to be re-linked this
...@@ -289,19 +365,11 @@ cmLoadModule cmstate1 rootname ...@@ -289,19 +365,11 @@ cmLoadModule cmstate1 rootname
-- clean up after ourselves -- clean up after ourselves
cleanTempFilesExcept verb (ppFilesFromSummaries modsDone) cleanTempFilesExcept verb (ppFilesFromSummaries modsDone)
linkresult -- link everything together
<- link ghci_mode dflags a_root_is_Main ui3 pls2 linkresult <- link ghci_mode dflags a_root_is_Main ui3 pls2
case linkresult of
LinkErrs _ _ cmLoadFinish True linkresult
-> panic "cmLoadModule: link failed (1)" hst3 hit3 ui3 modsDone ghci_mode pcs3
LinkOK pls3
-> do let cmstate3
= CmState { hst=hst3, hit=hit3,
ui=ui3, mg=modsDone,
gmode=ghci_mode,
pcs=pcs3, pls=pls3 }
return (cmstate3, True,
map ms_mod modsDone)
else else
-- Tricky. We need to back out the effects of compiling any -- Tricky. We need to back out the effects of compiling any
...@@ -313,34 +381,50 @@ cmLoadModule cmstate1 rootname ...@@ -313,34 +381,50 @@ cmLoadModule cmstate1 rootname
let modsDone_names let modsDone_names
= map name_of_summary modsDone = map name_of_summary modsDone
let mods_to_zap_names let mods_to_zap_names
= findPartiallyCompletedCycles modsDone_names mg2_with_srcimps = findPartiallyCompletedCycles modsDone_names
let (hst4, hit4, ui4) mg2_with_srcimps
let (hst4, hit4, ui4)
= removeFromTopLevelEnvs mods_to_zap_names (hst3,hit3,ui3) = removeFromTopLevelEnvs mods_to_zap_names (hst3,hit3,ui3)
let mods_to_keep let mods_to_keep
= filter ((`notElem` mods_to_zap_names).name_of_summary) modsDone = filter ((`notElem` mods_to_zap_names).name_of_summary)
let mods_to_keep_names modsDone
= map name_of_summary mods_to_keep
-- we could get the relevant linkables by filtering newLis, but
-- it seems easier to drag them out of the updated, cleaned-up UI
let linkables_to_link
= map (unJust "linkables_to_link" . findModuleLinkable_maybe ui4)
mods_to_keep_names
-- clean up after ourselves -- clean up after ourselves
cleanTempFilesExcept verb (ppFilesFromSummaries mods_to_keep) cleanTempFilesExcept verb (ppFilesFromSummaries mods_to_keep)
linkresult <- link ghci_mode dflags False linkables_to_link pls2 -- link everything together
case linkresult of linkresult <- link ghci_mode dflags False ui4 pls2
LinkErrs _ _
-> panic "cmLoadModule: link failed (2)"
LinkOK pls3
-> do let cmstate4
= CmState { hst=hst4, hit=hit4,
ui=ui4, mg=mods_to_keep,
gmode=ghci_mode, pcs=pcs3, pls=pls3 }
return (cmstate4, False,
map ms_mod mods_to_keep)
cmLoadFinish False linkresult
hst4 hit4 ui4 mods_to_keep ghci_mode pcs3
-- Finish up after a cmLoad.
--
-- Empty the interactive context and set the module context to the topmost
-- newly loaded module, or the Prelude if none were loaded.
cmLoadFinish ok linkresult hst hit ui mods ghci_mode pcs
= do case linkresult of {
LinkErrs _ _ -> panic "cmLoadModule: link failed (2)";
LinkOK pls -> do
def_mod <- readIORef defaultCurrentModule
let current_mod = case mods of
[] -> def_mod
(x:_) -> ms_mod x