[project @ 2001-01-18 12:54:16 by simonmar]

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

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 45a3e18..cf301f4 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.23 2000/12/13 12:18:40 sewardj Exp $
+-- $Id: InteractiveUI.hs,v 1.28 2001/01/18 12:54:16 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -14,13 +14,12 @@ module InteractiveUI (interactiveUI) where
 import CompManager
 import CmStaticInfo
 import DriverFlags
-import DriverUtil
 import DriverState
 import Linker
 import Module
 import Outputable
 import Util
-import TypeRep {- instance Outputable Type; do not delete -}
+import PprType {- instance Outputable Type; do not delete -}
 import Panic   ( GhcException(..) )
 
 import Exception
@@ -36,6 +35,7 @@ import CPUTime
 import Directory
 import IO
 import Char
+import Monad ( when )
 
 
 -----------------------------------------------------------------------------
@@ -118,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 ()
@@ -162,21 +163,35 @@ runCommand c =
    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 "PrelHandle.hFlush PrelHandle.stdout" >> return ())
+                              when ok (evalExpr "PrelHandle.hFlush PrelHandle.stderr" >> 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
@@ -272,8 +287,9 @@ typeOfExpr :: String -> GHCi ()
 typeOfExpr str 
   = do st <- getGHCiState
        dflags <- io (getDynFlags)
-       (st, maybe_ty) <- io (cmGetExpr (cmstate st) dflags 
-                               (current_module st) str)
+       (new_cmstate, maybe_ty) <- io (cmGetExpr (cmstate st) dflags 
+                               (current_module st) str False)
+       setGHCiState st{cmstate = new_cmstate}
        case maybe_ty of
         Nothing -> return ()
         Just (_, unqual, ty) -> io (printForUser stdout unqual (ppr ty)) 
@@ -372,6 +388,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
 
@@ -381,7 +436,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
@@ -412,6 +468,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 ->