Implement stack chunks and separate TSO/STACK objects

[ghc-hetmet.git] / ghc / InteractiveUI.hs

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 03d0370..e22eaef 100644 (file)
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -294,6 +294,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
@@ -344,10 +352,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 = [],
@@ -404,8 +412,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 `IO.catch` \_ -> return ())
      where
       getDirectory f = case takeDirectory f of "" -> "."; d -> d
 
@@ -1516,22 +1526,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
+  =   -- 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
- 
-       let no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
-           no_flag f = ghcError (ProgramError ("don't know how to reverse " ++ f))
+             mapM_ unsetOpt plus_opts
 
-       no_flags <- mapM no_flag minus_opts
-       newDynFlags no_flags
+             no_flags <- mapM no_flag minus_opts
+             newDynFlags no_flags
 
 isMinus :: String -> Bool
 isMinus ('-':_) = True
@@ -1963,11 +1983,11 @@ historyCmd arg
           _  -> do
                  spans <- mapM GHC.getHistorySpan took
                  let nums  = map (printf "-%-3d:") [(1::Int)..]
-                     names = map GHC.historyEnclosingDecl took
+                     names = map GHC.historyEnclosingDecls took
                  printForUser (vcat(zipWith3 
                                  (\x y z -> x <+> y <+> z) 
                                  (map text nums) 
-                                 (map (bold . ppr) names)
+                                 (map (bold . hcat . punctuate colon . map text) names)
                                  (map (parens . ppr) spans)))
                  liftIO $ putStrLn $ if null rest then "<end of history>" else "..."