import System.IO
import System.IO.Error as IO
import Data.Char
-import Data.Dynamic
import Data.Array
import Control.Monad as Monad
import Text.Printf
interactiveUI :: [(FilePath, Maybe Phase)] -> Maybe [String]
-> Ghc ()
-interactiveUI srcs maybe_exprs = do
+interactiveUI srcs maybe_exprs = withTerminalReset $ do
-- HACK! If we happen to get into an infinite loop (eg the user
-- types 'let x=x in x' at the prompt), then the thread will block
-- on a blackhole, and become unreachable during GC. The GC will
Right dir -> right dir
_ -> left
+-- libedit doesn't always restore the terminal settings correctly (as of at
+-- least 07/12/2008); see trac #2691. Work around this by manually resetting
+-- the terminal outselves.
+withTerminalReset :: Ghc () -> Ghc ()
+#ifdef mingw32_HOST_OS
+withTerminalReset = id
+#else
+withTerminalReset f = do
+ isTTY <- liftIO $ hIsTerminalDevice stdout
+ if not isTTY
+ then f
+ else gbracket (liftIO $ getTerminalAttributes stdOutput)
+ (\attrs -> liftIO $ setTerminalAttributes stdOutput attrs Immediately)
+ (const f)
+#endif
runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
runGHCi paths maybe_exprs = do
where
printErrorAndKeepGoing err = do
GHC.printExceptionAndWarnings err
- return True
+ return False
noSpace q = q >>= maybe (return Nothing)
(\c->case removeSpaces c of
let modl = GHC.mkModuleName m
prev_context <- GHC.getContext
ok <- handleSourceError (\e -> GHC.printExceptionAndWarnings e >> return False) $ do
- r <- GHC.typecheckModule =<< GHC.parseModule modl
+ r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl
io $ putStrLn (showSDoc (
case GHC.moduleInfo r of
cm | Just scope <- GHC.modInfoTopLevelScope cm ->
let
- (local,global) = partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
+ (local,global) = ASSERT( all isExternalName scope )
+ partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
in
(text "global names: " <+> ppr global) $$
(text "local names: " <+> ppr local)
-- We would like to improve this; see #1799.
sorted_names = loc_sort local ++ occ_sort external
where
- (local,external) = partition ((==modl) . nameModule) names
+ (local,external) = ASSERT( all isExternalName names )
+ partition ((==modl) . nameModule) names
occ_sort = sortBy (compare `on` nameOccName)
-- try to sort by src location. If the first name in
-- our list has a good source location, then they all should.
completeSetOptions w = do
return (filter (w `isPrefixOf`) options)
- where options = "args":"prog":allFlags
+ where options = "args":"prog":flagList
+ flagList = map head $ group $ sort allFlags
completeFilename w = do
ws <- Readline.filenameCompletionFunction w
ghciHandle handler (showException exception >> return False)
showException :: SomeException -> GHCi ()
-#if __GLASGOW_HASKELL__ < 609
-showException (DynException dyn) =
- case fromDynamic dyn of
- Nothing -> io (putStrLn ("*** Exception: (unknown)"))
- Just Interrupted -> io (putStrLn "Interrupted.")
- Just (CmdLineError s) -> io (putStrLn s) -- omit the location for CmdLineError
- Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
- Just other_ghc_ex -> io (print other_ghc_ex)
-
-showException other_exception
- = io (putStrLn ("*** Exception: " ++ show other_exception))
-#else
-showException (SomeException e) =
- io $ case cast e of
+showException se =
+ io $ case fromException se of
Just Interrupted -> putStrLn "Interrupted."
-- omit the location for CmdLineError:
Just (CmdLineError s) -> putStrLn s
-- ditto:
Just ph@(PhaseFailed {}) -> putStrLn (showGhcException ph "")
Just other_ghc_ex -> print other_ghc_ex
- Nothing -> putStrLn ("*** Exception: " ++ show e)
-#endif
+ Nothing -> putStrLn ("*** Exception: " ++ show se)
-----------------------------------------------------------------------------
-- recursive exception handlers
case names of
[] -> return ()
(n:_) -> do
- let modl = GHC.nameModule n
+ let modl = ASSERT( isExternalName n ) GHC.nameModule n
if not (GHC.isExternalName n)
then noCanDo n $ ppr n <>
text " is not defined in an interpreted module"
wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
if GHC.isGoodSrcLoc loc
- then findBreakAndSet (GHC.nameModule name) $
+ then ASSERT( isExternalName name )
+ findBreakAndSet (GHC.nameModule name) $
findBreakByCoord (Just (GHC.srcLocFile loc))
(GHC.srcLocLine loc,
GHC.srcLocCol loc)
let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
if GHC.isGoodSrcLoc loc
then do
- tickArray <- getTickArray (GHC.nameModule name)
+ tickArray <- ASSERT( isExternalName name )
+ getTickArray (GHC.nameModule name)
let mb_span = findBreakByCoord (Just (GHC.srcLocFile loc))
(GHC.srcLocLine loc, GHC.srcLocCol loc)
tickArray