projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2002-03-18 15:23:05 by simonpj]
[ghc-hetmet.git]
/
ghc
/
compiler
/
ghci
/
InteractiveUI.hs
diff --git
a/ghc/compiler/ghci/InteractiveUI.hs
b/ghc/compiler/ghci/InteractiveUI.hs
index
bb84229
..
5205d71
100644
(file)
--- a/
ghc/compiler/ghci/InteractiveUI.hs
+++ b/
ghc/compiler/ghci/InteractiveUI.hs
@@
-1,6
+1,6
@@
{-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
-----------------------------------------------------------------------------
{-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
-----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.111 2002/01/28 12:01:12 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.116 2002/02/28 10:15:47 simonmar Exp $
--
-- GHC Interactive User Interface
--
--
-- GHC Interactive User Interface
--
@@
-30,7
+30,7
@@
import Util
import Id ( isRecordSelector, recordSelectorFieldLabel,
isDataConWrapId, isDataConId, idName )
import Class ( className )
import Id ( isRecordSelector, recordSelectorFieldLabel,
isDataConWrapId, isDataConId, idName )
import Class ( className )
-import TyCon ( tyConName, tyConClass_maybe, isPrimTyCon )
+import TyCon ( tyConName, tyConClass_maybe, isPrimTyCon, DataConDetails(..) )
import FieldLabel ( fieldLabelTyCon )
import SrcLoc ( isGoodSrcLoc )
import Module ( moduleName )
import FieldLabel ( fieldLabelTyCon )
import SrcLoc ( isGoodSrcLoc )
import Module ( moduleName )
@@
-67,7
+67,8
@@
import IO
import Char
import Monad
import Char
import Monad
-import PrelGHC ( unsafeCoerce# )
+import GlaExts ( unsafeCoerce# )
+
import Foreign ( nullPtr )
import CString ( peekCString )
import Foreign ( nullPtr )
import CString ( peekCString )
@@
-162,17
+163,21
@@
interactiveUI cmstate paths cmdline_libs = do
_ -> panic "interactiveUI:buffering"
(cmstate, maybe_hval)
_ -> panic "interactiveUI:buffering"
(cmstate, maybe_hval)
- <- cmCompileExpr cmstate dflags "IO.hFlush PrelHandle.stderr"
+ <- cmCompileExpr cmstate dflags "IO.hFlush IO.stderr"
case maybe_hval of
Just hval -> writeIORef flush_stderr (unsafeCoerce# hval :: IO ())
_ -> panic "interactiveUI:stderr"
(cmstate, maybe_hval)
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"
+ <- cmCompileExpr cmstate dflags "IO.hFlush IO.stdout"
case maybe_hval of
Just hval -> writeIORef flush_stdout (unsafeCoerce# hval :: IO ())
_ -> panic "interactiveUI:stdout"
case maybe_hval of
Just hval -> writeIORef flush_stdout (unsafeCoerce# hval :: IO ())
_ -> panic "interactiveUI:stdout"
+ -- We don't want the cmd line to buffer any input that might be
+ -- intended for the program, so unbuffer stdin.
+ hSetBuffering stdin NoBuffering
+
-- initial context is just the Prelude
cmstate <- cmSetContext cmstate dflags [] ["Prelude"]
-- initial context is just the Prelude
cmstate <- cmSetContext cmstate dflags [] ["Prelude"]
@@
-267,7
+272,7
@@
interactiveLoop is_tty = do
checkPerms :: String -> IO Bool
checkPerms name =
checkPerms :: String -> IO Bool
checkPerms name =
- handle (\_ -> return False) $ do
+ DriverUtil.handle (\_ -> return False) $ do
#ifdef mingw32_TARGET_OS
doesFileExist name
#else
#ifdef mingw32_TARGET_OS
doesFileExist name
#else
@@
-675,8
+680,8
@@
browseModule m exports_only = do
thingDecl thing@(ATyCon t) =
let rn_decl = ifaceTyThing thing in
case rn_decl of
thingDecl thing@(ATyCon t) =
let rn_decl = ifaceTyThing thing in
case rn_decl of
- TyData { tcdCons = cons } ->
- rn_decl{ tcdCons = filter conIsVisible cons }
+ TyData { tcdCons = DataCons cons } ->
+ rn_decl{ tcdCons = DataCons (filter conIsVisible cons) }
other -> other
where
conIsVisible (ConDecl n _ _ _ _ _) = n `elem` thing_names
other -> other
where
conIsVisible (ConDecl n _ _ _ _ _) = n `elem` thing_names
@@
-1147,7
+1152,7
@@
printTimes allocs psecs
looksLikeModuleName [] = False
looksLikeModuleName (c:cs) = isUpper c && all isAlphaNumEx cs
looksLikeModuleName [] = False
looksLikeModuleName (c:cs) = isUpper c && all isAlphaNumEx cs
-isAlphaNumEx c = isAlphaNum c || c == '_'
+isAlphaNumEx c = isAlphaNum c || c == '_' || c == '.'
maybePutStr dflags s | verbosity dflags > 0 = putStr s
| otherwise = return ()
maybePutStr dflags s | verbosity dflags > 0 = putStr s
| otherwise = return ()