Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
565f97b2
Commit
565f97b2
authored
Dec 13, 2011
by
dterei
Browse files
Tabs -> Spaces
parent
a3bd0b70
Changes
1
Hide whitespace changes
Inline
Side-by-side
ghc/GhciMonad.hs
View file @
565f97b2
{-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSp
-- for details
-----------------------------------------------------------------------------
--
-- Monadery code used in InteractiveUI
...
...
@@ -56,13 +49,13 @@ import Control.Monad.Trans as Trans
type
Command
=
(
String
,
String
->
InputT
GHCi
Bool
,
CompletionFunc
GHCi
)
data
GHCiState
=
GHCiState
{
progname
::
String
,
args
::
[
String
],
{
progname
::
String
,
args
::
[
String
],
prompt
::
String
,
editor
::
String
,
editor
::
String
,
stop
::
String
,
options
::
[
GHCiOption
],
options
::
[
GHCiOption
],
line_number
::
!
Int
,
-- input line
break_ctr
::
!
Int
,
breaks
::
!
[(
Int
,
BreakLocation
)],
...
...
@@ -97,12 +90,12 @@ data GHCiState = GHCiState
type
TickArray
=
Array
Int
[(
BreakIndex
,
SrcSpan
)]
data
GHCiOption
=
ShowTiming
-- show time/allocs after evaluation
|
ShowType
-- show the type of expressions
|
RevertCAFs
-- revert CAFs after every evaluation
data
GHCiOption
=
ShowTiming
-- show time/allocs after evaluation
|
ShowType
-- show the type of expressions
|
RevertCAFs
-- revert CAFs after every evaluation
|
Multiline
-- use multiline commands
deriving
Eq
deriving
Eq
data
BreakLocation
=
BreakLocation
...
...
@@ -110,14 +103,14 @@ data BreakLocation
,
breakLoc
::
!
SrcSpan
,
breakTick
::
{-# UNPACK #-}
!
Int
,
onBreakCmd
::
String
}
}
instance
Eq
BreakLocation
where
loc1
==
loc2
=
breakModule
loc1
==
breakModule
loc2
&&
breakTick
loc1
==
breakTick
loc2
prettyLocations
::
[(
Int
,
BreakLocation
)]
->
SDoc
prettyLocations
[]
=
text
"No active breakpoints."
prettyLocations
[]
=
text
"No active breakpoints."
prettyLocations
locs
=
vcat
$
map
(
\
(
i
,
loc
)
->
brackets
(
int
i
)
<+>
ppr
loc
)
$
reverse
$
locs
instance
Outputable
BreakLocation
where
...
...
@@ -129,7 +122,7 @@ instance Outputable BreakLocation where
recordBreak
::
BreakLocation
->
GHCi
(
Bool
{- was already present -}
,
Int
)
recordBreak
brkLoc
=
do
st
<-
getGHCiState
let
oldActiveBreaks
=
breaks
st
let
oldActiveBreaks
=
breaks
st
-- don't store the same break point twice
case
[
nm
|
(
nm
,
loc
)
<-
oldActiveBreaks
,
loc
==
brkLoc
]
of
(
nm
:
_
)
->
return
(
True
,
nm
)
...
...
@@ -218,7 +211,7 @@ instance Haskeline.MonadException GHCi where
catch
=
gcatch
block
=
gblock
unblock
=
gunblock
-- XXX when Haskeline's MonadException changes, we can drop our
-- XXX when Haskeline's MonadException changes, we can drop our
-- deprecated block/unblock methods
instance
ExceptionMonad
(
InputT
GHCi
)
where
...
...
@@ -228,7 +221,7 @@ instance ExceptionMonad (InputT GHCi) where
gunblock
=
Haskeline
.
unblock
setDynFlags
::
DynFlags
->
GHCi
[
PackageId
]
setDynFlags
dflags
=
do
setDynFlags
dflags
=
do
GHC
.
setSessionDynFlags
dflags
isOptionSet
::
GHCiOption
->
GHCi
Bool
...
...
@@ -263,7 +256,7 @@ runStmt expr step = do
withProgName
(
progname
st
)
$
withArgs
(
args
st
)
$
reflectGHCi
x
$
do
GHC
.
handleSourceError
(
\
e
->
do
GHC
.
printException
e
;
GHC
.
handleSourceError
(
\
e
->
do
GHC
.
printException
e
;
return
Nothing
)
$
do
r
<-
GHC
.
runStmtWithLocation
(
progname
st
)
(
line_number
st
)
expr
step
return
(
Just
r
)
...
...
@@ -293,41 +286,41 @@ resume canLogSpan step = do
timeIt
::
InputT
GHCi
a
->
InputT
GHCi
a
timeIt
action
=
do
b
<-
lift
$
isOptionSet
ShowTiming
if
not
b
then
action
else
do
allocs1
<-
liftIO
$
getAllocations
time1
<-
liftIO
$
getCPUTime
a
<-
action
allocs2
<-
liftIO
$
getAllocations
time2
<-
liftIO
$
getCPUTime
liftIO
$
printTimes
(
fromIntegral
(
allocs2
-
allocs1
))
(
time2
-
time1
)
return
a
if
not
b
then
action
else
do
allocs1
<-
liftIO
$
getAllocations
time1
<-
liftIO
$
getCPUTime
a
<-
action
allocs2
<-
liftIO
$
getAllocations
time2
<-
liftIO
$
getCPUTime
liftIO
$
printTimes
(
fromIntegral
(
allocs2
-
allocs1
))
(
time2
-
time1
)
return
a
foreign
import
ccall
unsafe
"getAllocations"
getAllocations
::
IO
Int64
-- defined in ghc/rts/Stats.c
-- defined in ghc/rts/Stats.c
printTimes
::
Integer
->
Integer
->
IO
()
printTimes
allocs
psecs
=
do
let
secs
=
(
fromIntegral
psecs
/
(
10
^
(
12
::
Integer
)))
::
Float
secs_str
=
showFFloat
(
Just
2
)
secs
putStrLn
(
showSDoc
(
parens
(
text
(
secs_str
""
)
<+>
text
"secs"
<>
comma
<+>
text
(
show
allocs
)
<+>
text
"bytes"
)))
secs_str
=
showFFloat
(
Just
2
)
secs
putStrLn
(
showSDoc
(
parens
(
text
(
secs_str
""
)
<+>
text
"secs"
<>
comma
<+>
text
(
show
allocs
)
<+>
text
"bytes"
)))
-----------------------------------------------------------------------------
-- reverting CAFs
revertCAFs
::
GHCi
()
revertCAFs
=
do
liftIO
rts_revertCAFs
s
<-
getGHCiState
when
(
not
(
ghc_e
s
))
$
liftIO
turnOffBuffering
-- Have to turn off buffering again, because we just
-- reverted stdout, stderr & stdin to their defaults.
-- Have to turn off buffering again, because we just
-- reverted stdout, stderr & stdin to their defaults.
foreign
import
ccall
"revertCAFs"
rts_revertCAFs
::
IO
()
-- Make it "safe", just in case
foreign
import
ccall
"revertCAFs"
rts_revertCAFs
::
IO
()
-- Make it "safe", just in case
-----------------------------------------------------------------------------
-- To flush buffers for the *interpreted* computation we need
...
...
@@ -383,3 +376,4 @@ getHandle :: IORef (Ptr ()) -> IO Handle
getHandle
ref
=
do
(
Ptr
addr
)
<-
readIORef
ref
case
addrToAny
#
addr
of
(
#
hval
#
)
->
return
(
unsafeCoerce
#
hval
)
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