[project @ 2000-11-21 15:00:57 by simonmar]

* :t works !!!  (but it's a bit excessive about qualifying everything
  at the moment).

* lots of other things work.

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index bb08b7b..16b139d 100644 (file)
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -6,7 +6,7 @@
 \begin{code}
 module CompManager ( cmInit, cmLoadModule,
 #ifdef GHCI
-                     cmGetExpr, cmRunExpr,
+                     cmGetExpr, cmTypeExpr, cmRunExpr,
 #endif
                      CmState, emptyCmState  -- abstract
                    )
@@ -25,6 +25,7 @@ import DriverPipeline
 import GetImports
 import HscTypes                ( HomeSymbolTable, HomeIfaceTable, 
                          PersistentCompilerState, ModDetails(..) )
+import Type            ( Type )
 import Name            ( lookupNameEnv )
 import Module
 import PrelNames       ( mainName )
@@ -45,7 +46,7 @@ import Panic          ( panic )
 #ifdef GHCI
 import CmdLineOpts     ( DynFlags(..) )
 import Interpreter     ( HValue )
-import HscMain         ( hscExpr )
+import HscMain         ( hscExpr, hscTypeExpr )
 import RdrName
 import PrelGHC         ( unsafeCoerce# )
 #endif
@@ -88,6 +89,19 @@ cmGetExpr cmstate dflags modname expr
        CmState{ pcs=pcs, pcms=pcms, pls=pls } = cmstate
        PersistentCMState{ hst=hst, hit=hit } = pcms
 
+cmTypeExpr :: CmState
+         -> DynFlags
+          -> ModuleName
+          -> String
+          -> IO (CmState, Maybe Type)
+cmTypeExpr cmstate dflags modname expr
+   = do (new_pcs, expr_type) <- 
+          hscTypeExpr dflags hst hit pcs (mkHomeModule modname) expr
+        return (cmstate{ pcs=new_pcs }, expr_type)
+   where
+       CmState{ pcs=pcs, pcms=pcms, pls=pls } = cmstate
+       PersistentCMState{ hst=hst, hit=hit } = pcms
+
 -- The HValue should represent a value of type IO () (Perhaps IO a?)
 cmRunExpr :: HValue -> IO ()
 cmRunExpr hval

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 39bbe01..97071d7 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.8 2000/11/21 14:32:44 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.9 2000/11/21 15:00:58 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -122,7 +122,7 @@ runCommand c =
 doCommand (':' : command) = specialCommand command
 doCommand expr
  = do st <- getGHCiState
-      dflags <- io (readIORef v_DynFlags)
+      dflags <- io (getDynFlags)
       (new_cmstate, maybe_hvalue) <- 
         io (cmGetExpr (cmstate st) dflags (current_module st) expr)
       setGHCiState st{cmstate = new_cmstate}
@@ -216,7 +216,14 @@ setOptions str =
    )
 
 typeOfExpr :: String -> GHCi ()
-typeOfExpr = panic "typeOfExpr"
+typeOfExpr str 
+  = do st <- getGHCiState
+       dflags <- io (getDynFlags)
+       (st, maybe_ty) <- io (cmTypeExpr (cmstate st) dflags 
+                               (current_module st) str)
+       case maybe_ty of
+        Nothing -> return ()
+        Just ty -> io (putStrLn (showSDoc (ppr ty)))
 
 quit :: String -> GHCi ()
 quit _ = return ()

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 34917d3..22b1298 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -4,7 +4,7 @@
 \section[GHC_Main]{Main driver for Glasgow Haskell compiler}
 
 \begin{code}
-module HscMain ( HscResult(..), hscMain, hscExpr,
+module HscMain ( HscResult(..), hscMain, hscExpr, hscTypeExpr,
                 initPersistentCompilerState ) where
 
 #include "HsVersions.h"
@@ -28,6 +28,8 @@ import PrelNames      ( knownKeyNames )
 import MkIface         ( completeIface, mkModDetailsFromIface, mkModDetails,
                          writeIface, pprIface )
 import TcModule
+import Type
+import TcHsSyn
 import InstEnv         ( emptyInstEnv )
 import Desugar
 import SimplCore
@@ -401,42 +403,33 @@ hscExpr dflags hst hit pcs this_module expr
 #else 
 
 hscExpr dflags hst hit pcs0 this_module expr
-  = do {       -- Parse it
-       maybe_parsed <- hscParseExpr dflags expr;
-       case maybe_parsed of
-            Nothing -> return (pcs0, Nothing)
-            Just parsed_expr -> do {
+   = do {
+       -- parse, rename & typecheck the expression
+        (pcs1, maybe_tc_result)
+          <- hscExprFrontEnd dflags hst hit pcs0 this_module expr;
 
-               -- Rename it
-       (pcs1, maybe_renamed_expr) <- 
-               renameExpr dflags hit hst pcs0 this_module parsed_expr;
-       case maybe_renamed_expr of
-               Nothing -> return (pcs1, Nothing)
-               Just (print_unqual, rn_expr) -> do {
-
-               -- Typecheck it
-       maybe_tc_return
-          <- typecheckExpr dflags pcs1 hst print_unqual this_module rn_expr;
-       case maybe_tc_return of
-               Nothing -> return (pcs1, Nothing)
-               Just (pcs2, tc_expr, ty) -> do {
+       case maybe_tc_result of {
+          Nothing -> return (pcs1, Nothing);
+          Just (print_unqual, tc_expr, ty) -> do {
 
+       -- if it isn't an IO-typed expression, 
+       -- wrap "print" around it & recompile...
        let { is_IO_type = case splitTyConApp_maybe ty of {
                            Just (tycon, _) -> getUnique tycon == ioTyConKey;
                            Nothing -> False }
             };
 
         if (not is_IO_type)
-               then hscExpr dflags hst hit pcs2 this_module 
+               then hscExpr dflags hst hit pcs1 this_module 
                        ("print (" ++ expr ++ ")")
                else do
 
                -- Desugar it
-       ds_expr <- deSugarExpr dflags pcs2 hst this_module
+       ds_expr <- deSugarExpr dflags pcs1 hst this_module
                        print_unqual tc_expr;
        
                -- Simplify it
-       simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr;
+       simpl_expr <- simplifyExpr dflags pcs1 hst ds_expr;
 
                -- Convert to STG
        stg_expr <- coreToStgExpr dflags simpl_expr;
@@ -446,8 +439,56 @@ hscExpr dflags hst hit pcs0 this_module expr
                -- Convert to InterpSyn
        unlinked_iexpr <- stgExprToInterpSyn dflags stg_expr;
 
-       return (pcs2, Just unlinked_iexpr);
-     }}}}
+       return (pcs1, Just unlinked_iexpr);
+     }}}
+
+hscExprFrontEnd
+  :: DynFlags
+  -> HomeSymbolTable   
+  -> HomeIfaceTable
+  -> PersistentCompilerState    -- IN: persistent compiler state
+  -> Module                    -- Context for compiling
+  -> String                    -- The expression
+  -> IO ( PersistentCompilerState, 
+         Maybe (PrintUnqualified,TypecheckedHsExpr,Type) 
+       )
+hscExprFrontEnd dflags hst hit pcs0 this_module expr
+  = do {       -- Parse it
+       maybe_parsed <- hscParseExpr dflags expr;
+       case maybe_parsed of
+            Nothing -> return (pcs0, Nothing)
+            Just parsed_expr -> do {
+
+               -- Rename it
+       (pcs1, maybe_renamed_expr) <- 
+               renameExpr dflags hit hst pcs0 this_module parsed_expr;
+       case maybe_renamed_expr of
+               Nothing -> return (pcs1, Nothing)
+               Just (print_unqual, rn_expr) -> do {
+
+               -- Typecheck it
+       maybe_tc_return
+          <- typecheckExpr dflags pcs1 hst print_unqual this_module rn_expr;
+       case maybe_tc_return of
+               Nothing -> return (pcs1, Nothing)
+               Just (pcs2, tc_expr, ty) -> 
+                  return (pcs2, Just (print_unqual, tc_expr, ty))
+    }}}
+
+hscTypeExpr
+  :: DynFlags
+  -> HomeSymbolTable   
+  -> HomeIfaceTable
+  -> PersistentCompilerState    -- IN: persistent compiler state
+  -> Module                    -- Context for compiling
+  -> String                    -- The expression
+  -> IO (PersistentCompilerState, Maybe Type)
+hscTypeExpr dflags hst hit pcs0 this_module expr
+  = do (pcs1, maybe_tc_result)
+         <- hscExprFrontEnd dflags hst hit pcs0 this_module expr
+       case maybe_tc_result of
+         Nothing -> return (pcs1, Nothing)
+         Just (_,_,ty) -> return (pcs1, Just ty)
 
 hscParseExpr :: DynFlags -> String -> IO (Maybe RdrNameHsExpr)
 hscParseExpr dflags str