Commit 565f97b2 authored by dterei's avatar dterei
Browse files

Tabs -> Spaces

parent a3bd0b70
{-# 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)
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