X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2FInteractiveUI.hs;h=2f3ca85dece9910fb2251e960c61aac479139d99;hp=552b61cdc37f24f88ca84fb108be30206c4aec5a;hb=b00e3a6c0a82a8af3238d677f798d812cd7fd49f;hpb=add9b7f13aad3a6ec5fdb4512c79ee9c5d95b3d4

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 552b61c..2f3ca85 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -89,12 +89,8 @@ import Text.Printf
 import Foreign
 import GHC.Exts		( unsafeCoerce# )
 
-#if __GLASGOW_HASKELL__ >= 611
 import GHC.IO.Exception	( IOErrorType(InvalidArgument) )
 import GHC.IO.Handle    ( hFlushAll )
-#else
-import GHC.IOBase	( IOErrorType(InvalidArgument) )
-#endif
 
 import GHC.TopHandler
 
@@ -284,7 +280,7 @@ helpText =
 findEditor :: IO String
 findEditor = do
   getEnv "EDITOR" 
-    `IO.catch` \_ -> do
+    `catchIO` \_ -> do
 #if mingw32_HOST_OS
         win <- System.Win32.getWindowsDirectory
         return (win </> "notepad.exe")
@@ -294,6 +290,14 @@ findEditor = do
 
 foreign import ccall unsafe "rts_isProfiled" isProfiled :: IO CInt
 
+default_progname, default_prompt, default_stop :: String
+default_progname = "<interactive>"
+default_prompt = "%s> "
+default_stop = ""
+
+default_args :: [String]
+default_args = []
+
 interactiveUI :: [(FilePath, Maybe Phase)] -> Maybe [String]
               -> Ghc ()
 interactiveUI srcs maybe_exprs = do
@@ -330,7 +334,7 @@ interactiveUI srcs maybe_exprs = do
         -- We don't want the cmd line to buffer any input that might be
         -- intended for the program, so unbuffer stdin.
         hSetBuffering stdin NoBuffering
-#if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 611
+#if defined(mingw32_HOST_OS)
         -- On Unix, stdin will use the locale encoding.  The IO library
         -- doesn't do this on Windows (yet), so for now we use UTF-8,
         -- for consistency with GHC 6.10 and to make the tests work.
@@ -344,10 +348,10 @@ interactiveUI srcs maybe_exprs = do
    default_editor <- liftIO $ findEditor
 
    startGHCi (runGHCi srcs maybe_exprs)
-        GHCiState{ progname = "<interactive>",
-                   args = [],
-                   prompt = "%s> ",
-                   stop = "",
+        GHCiState{ progname = default_progname,
+                   args = default_args,
+                   prompt = default_prompt,
+                   stop = default_stop,
                    editor = default_editor,
 --                   session = session,
                    options = [],
@@ -365,14 +369,16 @@ interactiveUI srcs maybe_exprs = do
 
 withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a
 withGhcAppData right left = do
-   either_dir <- IO.try (getAppUserDataDirectory "ghc")
-   case either_dir of
-      Right dir -> right dir
-      _ -> left
+    either_dir <- IO.try (getAppUserDataDirectory "ghc")
+    case either_dir of
+        Right dir ->
+            do createDirectoryIfMissing False dir `catchIO` \_ -> return ()
+               right dir
+        _ -> left
 
 runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
 runGHCi paths maybe_exprs = do
-  let 
+  let
    read_dot_files = not opt_IgnoreDotGhci
 
    current_dir = return (Just ".ghci")
@@ -404,8 +410,10 @@ runGHCi paths maybe_exprs = do
            -- NOTE: this assumes that runInputT won't affect the terminal;
            -- can we assume this will always be the case?
            -- This would be a good place for runFileInputT.
-           Right hdl -> runInputTWithPrefs defaultPrefs defaultSettings $ do
+           Right hdl ->
+               do runInputTWithPrefs defaultPrefs defaultSettings $
                             runCommands $ fileLoop hdl
+                  liftIO (hClose hdl `catchIO` \_ -> return ())
      where
       getDirectory f = case takeDirectory f of "" -> "."; d -> d
 
@@ -648,15 +656,12 @@ runStmt stmt step
  | "import " `isPrefixOf` stmt
  = do newContextCmd (Import stmt); return False
  | otherwise
- = do
-#if __GLASGOW_HASKELL__ >= 611
-      -- In the new IO library, read handles buffer data even if the Handle
+ = do -- In the new IO library, read handles buffer data even if the Handle
       -- is set to NoBuffering.  This causes problems for GHCi where there
       -- are really two stdin Handles.  So we flush any bufferred data in
       -- GHCi's stdin Handle here (only relevant if stdin is attached to
       -- a file, otherwise the read buffer can't be flushed).
       _ <- liftIO $ IO.try $ hFlushAll stdin
-#endif
       result <- GhciMonad.runStmt stmt step
       afterRunStmt (const True) result
 
@@ -1516,22 +1521,32 @@ newDynFlags minus_opts = do
 
 unsetOptions :: String -> GHCi ()
 unsetOptions str
-  = do -- first, deal with the GHCi opts (+s, +t, etc.)
-       let opts = words str
-	   (minus_opts, rest1) = partition isMinus opts
-	   (plus_opts, rest2)  = partitionWith isPlus rest1
-
-       if (not (null rest2)) 
-	  then liftIO (putStrLn ("unknown option: '" ++ head rest2 ++ "'"))
-	  else do
-
-       mapM_ unsetOpt plus_opts
- 
-       let no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
-           no_flag f = ghcError (ProgramError ("don't know how to reverse " ++ f))
-
-       no_flags <- mapM no_flag minus_opts
-       newDynFlags no_flags
+  =   -- first, deal with the GHCi opts (+s, +t, etc.)
+     let opts = words str
+         (minus_opts, rest1) = partition isMinus opts
+         (plus_opts, rest2)  = partitionWith isPlus rest1
+         (other_opts, rest3) = partition (`elem` map fst defaulters) rest2
+
+         defaulters = 
+           [ ("args"  , setArgs default_args)
+           , ("prog"  , setProg default_progname)
+           , ("prompt", setPrompt default_prompt)
+           , ("editor", liftIO findEditor >>= setEditor)
+           , ("stop"  , setStop default_stop)
+           ]
+
+         no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
+         no_flag f = ghcError (ProgramError ("don't know how to reverse " ++ f))
+
+     in if (not (null rest3))
+           then liftIO (putStrLn ("unknown option: '" ++ head rest3 ++ "'"))
+           else do
+             mapM_ (fromJust.flip lookup defaulters) other_opts
+
+             mapM_ unsetOpt plus_opts
+
+             no_flags <- mapM no_flag minus_opts
+             newDynFlags no_flags
 
 isMinus :: String -> Bool
 isMinus ('-':_) = True