Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
a29fe417
Commit
a29fe417
authored
Feb 27, 2001
by
simonmar
Browse files
[project @ 2001-02-27 15:26:04 by simonmar]
- make flushing and :def work again in the interpreter
parent
8a097699
Changes
2
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/compMan/CompManager.lhs
View file @
a29fe417
...
...
@@ -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.
-- cmTypeOf
Name
: 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:
...
...
ghc/compiler/ghci/InteractiveUI.hs
View file @
a29fe417
-----------------------------------------------------------------------------
-- $Id: InteractiveUI.hs,v 1.5
2
2001/02/2
6
15:
0
6:
58
simonmar Exp $
-- $Id: InteractiveUI.hs,v 1.5
3
2001/02/2
7
15:
2
6:
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
)
}
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment