[project @ 2001-01-16 17:09:43 by sewardj]

Various ghci interactive UI fixes/improvements.

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index c930b58..16ba8d5 100644 (file)
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -70,10 +70,11 @@ cmGetExpr :: CmState
          -> DynFlags
           -> ModuleName
           -> String
+          -> Bool
           -> IO (CmState, Maybe (HValue, PrintUnqualified, Type))
-cmGetExpr cmstate dflags modname expr
+cmGetExpr cmstate dflags modname expr wrap_print
    = do (new_pcs, maybe_stuff) <- 
-          hscExpr dflags hst hit pcs (mkHomeModule modname) expr
+          hscExpr dflags hst hit pcs (mkHomeModule modname) expr wrap_print
         case maybe_stuff of
           Nothing     -> return (cmstate{ pcs=new_pcs }, Nothing)
           Just (bcos, print_unqual, ty) -> do

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index e699088..3b295f1 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.25 2001/01/10 17:19:01 sewardj Exp $
+-- $Id: InteractiveUI.hs,v 1.26 2001/01/16 17:09:43 sewardj Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -14,7 +14,6 @@ module InteractiveUI (interactiveUI) where
 import CompManager
 import CmStaticInfo
 import DriverFlags
-import DriverUtil
 import DriverState
 import Linker
 import Module
@@ -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,23 +163,34 @@ runCommand c =
    doCommand c
 
 doCommand (':' : command) = specialCommand command
-doCommand expr            = do timeIt (evalExpr expr
-                                       >> evalExpr "Prelude.putStr \"\n\"")
-                               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
@@ -275,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)) 
@@ -374,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
 
@@ -383,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
@@ -414,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 -> 

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index d61ce40..56527b2 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -398,10 +398,11 @@ hscExpr
   -> PersistentCompilerState    -- IN: persistent compiler state
   -> Module                    -- Context for compiling
   -> String                    -- The expression
+  -> Bool                      -- Should we wrap print if not IO-typed?
   -> IO ( PersistentCompilerState, 
          Maybe (UnlinkedBCOExpr, PrintUnqualified, Type) )
 
-hscExpr dflags hst hit pcs0 this_module expr
+hscExpr dflags hst hit pcs0 this_module expr wrap_print
    = do {
        maybe_parsed <- hscParseExpr dflags expr;
        case maybe_parsed of
@@ -429,10 +430,10 @@ hscExpr dflags hst hit pcs0 this_module expr
                            Nothing -> False }
             };
 
-        if (not is_IO_type)
+        if (wrap_print && not is_IO_type)
                then do (new_pcs, maybe_stuff)
-                         <- hscExpr dflags hst hit pcs2 this_module 
-                               ("print (" ++ expr ++ ")")
+                         <- hscExpr dflags hst hit pcs2 this_module
+                               ("print (" ++ expr ++ ")") False
                        case maybe_stuff of
                           Nothing -> return (new_pcs, maybe_stuff)
                           Just (bcos, _, _) ->