X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FInteractiveUI.hs;h=42246b204e39977dd52a80e84f79ec9236cdd59d;hb=dc1deadaafcb7b4ced8a6a072382b07c39999327;hp=22bff85338734640ea779af11f76704fa8901827;hpb=84e10e6c110f218991fc9573bcb16aa2e647e02c;p=ghc-hetmet.git

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 22bff85..42246b2 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -385,6 +385,10 @@ runGHCi paths maybe_exprs = do
       Right home -> return (Just (home </> ".ghci"))
       _ -> return Nothing
 
+   canonicalizePath' :: FilePath -> IO (Maybe FilePath)
+   canonicalizePath' fp = liftM Just (canonicalizePath fp)
+                `catchIO` \_ -> return Nothing
+
    sourceConfigFile :: FilePath -> GHCi ()
    sourceConfigFile file = do
      exists <- io $ doesFileExist file
@@ -404,9 +408,9 @@ runGHCi paths maybe_exprs = do
       getDirectory f = case takeDirectory f of "" -> "."; d -> d
 
   when (read_dot_files) $ do
-    cfgs0 <- sequence [ current_dir, app_user_dir, home_dir ]
-    cfgs <- io $ mapM canonicalizePath (catMaybes cfgs0)
-    mapM_ sourceConfigFile (nub cfgs)
+    mcfgs0 <- sequence [ current_dir, app_user_dir, home_dir ]
+    mcfgs <- io $ mapM canonicalizePath' (catMaybes mcfgs0)
+    mapM_ sourceConfigFile $ nub $ catMaybes mcfgs
         -- nub, because we don't want to read .ghci twice if the
         -- CWD is $HOME.
 
@@ -572,9 +576,14 @@ runCommands = runCommands' handler
 runCommands' :: (SomeException -> GHCi Bool) -- Exception handler
              -> InputT GHCi (Maybe String) -> InputT GHCi ()
 runCommands' eh getCmd = do
-    b <- handleGhcException (\e -> case e of
-                    Interrupted -> return False
-                    _other -> liftIO (print e) >> return True)
+    b <- ghandle (\e -> case fromException e of
+                          Just UserInterrupt -> return False
+                          _ -> case fromException e of
+                                 Just ghc_e ->
+                                   do liftIO (print (ghc_e :: GhcException))
+                                      return True
+                                 _other ->
+                                   liftIO (Exception.throwIO e))
             (runOneCommand eh getCmd)
     if b then return () else runCommands' eh getCmd
 
@@ -617,7 +626,7 @@ runOneCommand eh getCmd = do
       maybe (liftIO (ioError collectError))
             (\l->if removeSpaces l == ":}" 
                  then return (Just $ removeSpaces c) 
-                 else collectCommand q (c++map normSpace l))
+                 else collectCommand q (c ++ "\n" ++ map normSpace l))
       where normSpace '\r' = ' '
             normSpace   c  = c
     -- QUESTION: is userError the one to use here?
@@ -1726,13 +1735,15 @@ handler exception = do
 showException :: SomeException -> GHCi ()
 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 se)
+       Nothing                  -> 
+         case fromException se of
+           Just UserInterrupt -> putStrLn "Interrupted."
+           _other             -> putStrLn ("*** Exception: " ++ show se)
 
 -----------------------------------------------------------------------------
 -- recursive exception handlers