[project @ 2001-01-17 10:11:17 by sewardj]

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

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 534a715..3b295f1 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.20 2000/11/28 14:41:54 sewardj Exp $
+-- $Id: InteractiveUI.hs,v 1.26 2001/01/16 17:09:43 sewardj Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -14,15 +14,18 @@ module InteractiveUI (interactiveUI) where
 import CompManager
 import CmStaticInfo
 import DriverFlags
-import DriverUtil
 import DriverState
 import Linker
 import Module
 import Outputable
 import Util
+import PprType {- instance Outputable Type; do not delete -}
+import Panic   ( GhcException(..) )
 
 import Exception
+#ifndef NO_READLINE
 import Readline
+#endif
 import IOExts
 
 import Numeric
@@ -32,6 +35,8 @@ import CPUTime
 import Directory
 import IO
 import Char
+import Monad ( when )
+
 
 -----------------------------------------------------------------------------
 
@@ -113,7 +118,8 @@ interactiveUI cmstate mod = do
                              current_module = this_mod,
                              target = mod,
                              cmstate = cmstate',
-                             options = [ShowTiming]}
+                             options = [ShowTiming],
+                              last_expr = Nothing}
    return ()
 
 uiLoop :: GHCi ()
@@ -122,7 +128,8 @@ uiLoop = do
 #ifndef NO_READLINE
   l <- io (readline (moduleNameUserString (current_module st) ++ "> "))
 #else
-  l <- io (hGetLine stdin)
+  l_ok <- io (hGetLine stdin)
+  let l = Just l_ok
 #endif
   case l of
     Nothing -> exitGHCi
@@ -150,27 +157,40 @@ runCommand c =
                        io ( putStrLn ("Phase " ++ phase ++ " failed (code "
                                        ++ show code ++ ")"))
                Interrupted -> io (putStrLn "Interrupted.")
-               _ -> io (putStrLn (show (dyn :: BarfKind)))
+               _ -> io (putStrLn (show (dyn :: GhcException)))
              >> return False
     ) $
    doCommand c
 
 doCommand (':' : command) = specialCommand command
-doCommand expr            = timeIt (evalExpr expr) >> return False
-
+doCommand expr
+   = do expr_expanded <- expandExpr expr
+        -- io (putStrLn ( "Before: " ++ expr ++ "\nAfter:  " ++ expr_expanded))
+        expr_ok <- timeIt (do ok <- evalExpr expr_expanded
+                              when ok (evalExpr "PrelIO.putChar \'\\n\'" >> return ())
+                              return ok)
+        when expr_ok (rememberExpr expr_expanded)
+        return False
+
+-- Returned Bool indicates whether or not the expr was successfully
+-- parsed, renamed and typechecked.
+evalExpr :: String -> GHCi Bool
 evalExpr expr
+ | null (filter (not.isSpace) expr)
+ = return False
+ | otherwise
  = do st <- getGHCiState
       dflags <- io (getDynFlags)
       (new_cmstate, maybe_stuff) <- 
-        io (cmGetExpr (cmstate st) dflags (current_module st) expr)
+        io (cmGetExpr (cmstate st) dflags (current_module st) expr True)
       setGHCiState st{cmstate = new_cmstate}
       case maybe_stuff of
-        Nothing -> return ()
+        Nothing -> return False
         Just (hv, unqual, ty)
           -> do io (cmRunExpr hv)
                 b <- isOptionSet ShowType
-                if b then io (printForUser stdout unqual (text "::" <+> ppr ty))
-                     else return ()
+                io (when b (printForUser stdout unqual (text "::" <+> ppr ty)))
+                 return True
        
 {-
   let (mod,'.':str) = break (=='.') expr
@@ -267,7 +287,7 @@ typeOfExpr str
   = do st <- getGHCiState
        dflags <- io (getDynFlags)
        (st, maybe_ty) <- io (cmGetExpr (cmstate st) dflags 
-                               (current_module st) str)
+                               (current_module st) str False)
        case maybe_ty of
         Nothing -> return ()
         Just (_, unqual, ty) -> io (printForUser stdout unqual (ppr ty)) 
@@ -366,6 +386,45 @@ optToStr :: GHCiOption -> String
 optToStr ShowTiming = "s"
 optToStr ShowType   = "t"
 
+
+-----------------------------------------------------------------------------
+-- Code to do last-expression-entered stuff.  (a.k.a the $$ facility)
+
+-- Take a string and replace $$s in it with the last expr, if any.
+expandExpr :: String -> GHCi String
+expandExpr str
+   = do mle <- getLastExpr
+        return (outside mle str)
+     where
+        outside mle ('$':'$':cs)
+           = case mle of
+                Just le -> " (" ++ le ++ ") " ++ outside mle cs
+                Nothing -> outside mle cs
+
+        outside mle []           = []
+        outside mle ('"':str)    = '"' : inside2 mle str   -- "
+        outside mle ('\'':str)   = '\'' : inside1 mle str   -- '
+        outside mle (c:cs)       = c : outside mle cs
+
+        inside2 mle ('"':cs)  = '"' : outside mle cs   -- "
+        inside2 mle (c:cs)    = c : inside2 mle cs
+        inside2 mle []        = []
+
+        inside1 mle ('\'':cs) = '\'': outside mle cs
+        inside1 mle (c:cs)    = c : inside1 mle cs
+        inside1 mle []        = []
+
+
+rememberExpr :: String -> GHCi ()
+rememberExpr str
+   = do let cleaned = (clean . reverse . clean . reverse) str
+        let forget_me_not | null cleaned = Nothing
+                          | otherwise    = Just cleaned
+        setLastExpr forget_me_not
+     where
+        clean = dropWhile isSpace
+
+
 -----------------------------------------------------------------------------
 -- GHCi monad
 
@@ -375,7 +434,8 @@ data GHCiState = GHCiState
        current_module :: ModuleName,
        target         :: Maybe FilePath,
        cmstate        :: CmState,
-       options        :: [GHCiOption]
+       options        :: [GHCiOption],
+        last_expr      :: Maybe String
      }
 
 data GHCiOption = ShowTiming | ShowType deriving Eq
@@ -406,6 +466,14 @@ unsetOption opt
  = do st <- getGHCiState
       setGHCiState (st{ options = filter (/= opt) (options st) })
 
+getLastExpr :: GHCi (Maybe String)
+getLastExpr
+ = do st <- getGHCiState ; return (last_expr st)
+
+setLastExpr :: Maybe String -> GHCi ()
+setLastExpr last_expr
+ = do st <- getGHCiState ; setGHCiState (st{last_expr = last_expr})
+
 io m = GHCi $ \s -> m >>= \a -> return (s,a)
 
 ghciHandle h (GHCi m) = GHCi $ \s ->