Commit a29fe417 authored by simonmar's avatar simonmar
Browse files

[project @ 2001-02-27 15:26:04 by simonmar]

- make flushing and :def work again in the interpreter
parent 8a097699
......@@ -6,14 +6,27 @@
\begin{code}
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
cmRunStmt, -- :: CmState -> DynFlags -> String -> IO (CmState, [Name])
cmTypeOfExpr, -- :: CmState -> DynFlags -> String
-- -> IO (CmState, Maybe String)
cmTypeOfName, -- :: CmState -> Name -> IO (Maybe String)
cmCompileExpr,-- :: CmState -> DynFlags -> String
-- -> IO (CmState, Maybe HValue)#endif
#endif
CmState, emptyCmState -- abstract
)
......@@ -165,19 +178,24 @@ moduleNameToModule mn
-- cmRunStmt: Run a statement/expr.
#ifdef GHCI
cmRunStmt :: CmState -> DynFlags -> String -> IO (CmState, [Name])
cmRunStmt :: CmState -> DynFlags -> String
-> IO (CmState, -- new state
[Name]) -- names bound by this evaluation
cmRunStmt cmstate dflags expr
= do
let icontext = ic cmstate
InteractiveContext {
let InteractiveContext {
ic_rn_env = rn_env,
ic_type_env = type_env,
ic_module = this_mod } = icontext
(new_pcs, maybe_stuff) <- hscStmt dflags hst hit pcs icontext expr
(new_pcs, maybe_stuff)
<- hscStmt dflags hst hit pcs icontext expr
case maybe_stuff of
Nothing -> return (cmstate{ pcs=new_pcs }, [])
Just (ids, bcos) -> do
-- update the interactive context
let
new_rn_env = extendLocalRdrEnv rn_env (map idName ids)
......@@ -190,20 +208,40 @@ cmRunStmt cmstate dflags expr
new_ic = icontext { ic_rn_env = new_rn_env,
ic_type_env = new_type_env }
-- link it
hval <- linkExpr pls bcos
hvals <- unsafeCoerce# hval :: IO [HValue]
-- run it!
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)
return (cmstate{ pcs=new_pcs, pls=new_pls, ic=new_ic }, names)
-- ToDo: check that the module we passed in is sane/exists?
return (cmstate{ pcs=new_pcs, pls=new_pls, ic=new_ic }, names)
where
CmState{ hst=hst, hit=hit, pcs=pcs, pls=pls } = cmstate
CmState{ hst=hst, hit=hit, pcs=pcs, pls=pls, ic=icontext } = cmstate
#endif
-----------------------------------------------------------------------------
-- cmTypeOfExpr: returns a string representing the type of an expression
#ifdef GHCI
cmTypeOfExpr :: CmState -> DynFlags -> String -> IO (CmState, Maybe String)
cmTypeOfExpr cmstate dflags expr
= do (new_cmstate, names)
<- cmRunStmt cmstate dflags ("let __cmTypeOfExpr=" ++ expr)
case names of
[name] -> do maybe_tystr <- cmTypeOfName new_cmstate name
return (new_cmstate, maybe_tystr)
_other -> pprPanic "cmTypeOfExpr" (ppr names)
#endif
-----------------------------------------------------------------------------
-- cmTypeOf: returns a string representing the type of a name.
-- cmTypeOfName: returns a string representing the type of a name.
#ifdef GHCI
cmTypeOfName :: CmState -> Name -> IO (Maybe String)
cmTypeOfName CmState{ hit=hit, pcs=pcs, ic=ic } name
= case lookupNameEnv (ic_type_env ic) name of
......@@ -219,6 +257,42 @@ cmTypeOfName CmState{ hit=hit, pcs=pcs, ic=ic } name
in return (Just str)
_ -> panic "cmTypeOfName"
#endif
-----------------------------------------------------------------------------
-- cmCompileExpr: compile an expression and deliver an HValue
#ifdef GHCI
cmCompileExpr :: CmState -> DynFlags -> String -> IO (CmState, Maybe HValue)
cmCompileExpr cmstate dflags expr
= do
let InteractiveContext {
ic_rn_env = rn_env,
ic_type_env = type_env,
ic_module = this_mod } = icontext
(new_pcs, maybe_stuff)
<- hscStmt dflags hst hit pcs icontext
("let __cmCompileExpr="++expr)
case maybe_stuff of
Nothing -> return (cmstate{ pcs=new_pcs }, Nothing)
Just (ids, bcos) -> do
-- link it
hval <- linkExpr pls bcos
-- run it!
let thing_to_run = unsafeCoerce# hval :: IO [HValue]
hvals <- thing_to_run
case (ids,hvals) of
([id],[hv]) -> return (cmstate{ pcs=new_pcs }, Just hv)
_ -> panic "cmCompileExpr"
where
CmState{ hst=hst, hit=hit, pcs=pcs, pls=pls, ic=icontext } = cmstate
#endif
-----------------------------------------------------------------------------
-- cmInfo: return "info" about an expression. The info might be:
......
-----------------------------------------------------------------------------
-- $Id: InteractiveUI.hs,v 1.52 2001/02/26 15:06:58 simonmar Exp $
-- $Id: InteractiveUI.hs,v 1.53 2001/02/27 15:26:04 simonmar Exp $
--
-- GHC Interactive User Interface
--
......@@ -60,7 +60,7 @@ builtin_commands :: [(String, String -> GHCi Bool)]
builtin_commands = [
("add", keepGoing addModule),
("cd", keepGoing changeDirectory),
-- ("def", keepGoing defineMacro),
("def", keepGoing defineMacro),
("help", keepGoing help),
("?", keepGoing help),
("load", keepGoing loadModule),
......@@ -124,20 +124,18 @@ interactiveUI cmstate mod cmdline_libs = do
dflags <- getDynFlags
{-
(cmstate, _) <- cmRunStmt cmstate dflags False prel
"PrelHandle.hFlush PrelHandle.stdout"
case maybe_stuff of
Nothing -> return ()
Just (hv,_,_) -> writeIORef flush_stdout hv
(cmstate, _) <- cmGetExpr cmstate dflags False prel
"PrelHandle.hFlush PrelHandle.stdout"
case maybe_stuff of
Nothing -> return ()
Just (hv,_,_) -> writeIORef flush_stderr hv
-}
(cmstate, maybe_hval)
<- cmCompileExpr cmstate dflags "IO.hFlush PrelHandle.stderr"
case maybe_hval of
Just hval -> writeIORef flush_stderr (unsafeCoerce# hval :: IO ())
_ -> panic "interactiveUI:stderr"
(cmstate, maybe_hval)
<- cmCompileExpr cmstate dflags "IO.hFlush PrelHandle.stdout"
case maybe_hval of
Just hval -> writeIORef flush_stdout (unsafeCoerce# hval :: IO ())
_ -> panic "interactiveUI:stdout"
(unGHCi runGHCi) GHCiState{ target = mod,
cmstate = cmstate,
options = [ShowTiming] }
......@@ -278,11 +276,11 @@ showTypeOfName cmstate n
flushEverything :: GHCi ()
flushEverything
= io $ {-do flush_so <- readIORef flush_stdout
cmRunExpr flush_so
= io $ do flush_so <- readIORef flush_stdout
flush_so
flush_se <- readIORef flush_stdout
cmRunExpr flush_se
-} (return ())
flush_se
return ()
specialCommand :: String -> GHCi Bool
specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
......@@ -322,7 +320,6 @@ setContext str
changeDirectory :: String -> GHCi ()
changeDirectory d = io (setCurrentDirectory d)
{-
defineMacro :: String -> GHCi ()
defineMacro s = do
let (macro_name, definition) = break isSpace s
......@@ -332,7 +329,7 @@ defineMacro s = do
else do
if (macro_name `elem` map fst cmds)
then throwDyn (OtherError
("command `" ++ macro_name ++ "' already defined"))
("command `" ++ macro_name ++ "' is already defined"))
else do
-- give the expression a type signature, so we can be sure we're getting
......@@ -342,15 +339,17 @@ defineMacro s = do
-- compile the expression
st <- getGHCiState
dflags <- io (getDynFlags)
(new_cmstate, maybe_stuff) <-
io (cmGetExpr (cmstate st) dflags new_expr)
(new_cmstate, maybe_hv) <- io (cmCompileExpr (cmstate st) dflags new_expr)
setGHCiState st{cmstate = new_cmstate}
case maybe_stuff of
Nothing -> return ()
Just (hv, unqual, ty)
-> io (writeIORef commands
((macro_name, keepGoing (runMacro hv)) : cmds))
-}
case maybe_hv of
Nothing -> return ()
Just hv ->
do funs <- io (unsafeCoerce# hv :: IO [HValue])
case funs of
[fun] -> io (writeIORef commands
((macro_name, keepGoing (runMacro fun))
: cmds))
_ -> throwDyn (OtherError "defineMacro: bizarre")
runMacro :: HValue{-String -> IO String-} -> String -> GHCi ()
runMacro fun s = do
......@@ -414,15 +413,11 @@ typeOfExpr :: String -> GHCi ()
typeOfExpr str
= do st <- getGHCiState
dflags <- io (getDynFlags)
(new_cmstate, names)
<- io (cmRunStmt (cmstate st) dflags ("let it=" ++ str))
(new_cmstate, maybe_tystr) <- io (cmTypeOfExpr (cmstate st) dflags str)
setGHCiState st{cmstate = new_cmstate}
case names of
[name] -> do maybe_tystr <- io (cmTypeOfName new_cmstate name)
case maybe_tystr of
Nothing -> return ()
Just tystr -> io (putStrLn (":: " ++ tystr))
_other -> pprPanic "typeOfExpr" (ppr names)
case maybe_tystr of
Nothing -> return ()
Just tystr -> io (putStrLn tystr)
quit :: String -> GHCi Bool
quit _ = return True
......@@ -540,8 +535,8 @@ data GHCiOption
| RevertCAFs -- revert CAFs after every evaluation
deriving Eq
GLOBAL_VAR(flush_stdout, error "no flush_stdout", HValue)
GLOBAL_VAR(flush_stderr, error "no flush_stdout", HValue)
GLOBAL_VAR(flush_stdout, error "no flush_stdout", IO ())
GLOBAL_VAR(flush_stderr, error "no flush_stdout", IO ())
newtype GHCi a = GHCi { unGHCi :: GHCiState -> IO (GHCiState, a) }
......
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