From b5347f2f6535a4b67f9a40c20fb46b2e2221090c Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 22 Nov 2000 10:56:54 +0000
Subject: [PATCH] [project @ 2000-11-22 10:56:53 by simonmar] - :type now
 prints names unqualified when possible. - :module is
 implemented

---
 ghc/compiler/compMan/CompManager.lhs |    2 +-
 ghc/compiler/ghci/InteractiveUI.hs   |   25 ++++++++++++++++++++-----
 ghc/compiler/main/HscMain.lhs        |    4 ++--
 3 files changed, 23 insertions(+), 8 deletions(-)

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index 9148829..8041e61 100644
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -93,7 +93,7 @@ cmTypeExpr :: CmState
 	  -> DynFlags
           -> ModuleName
           -> String
-          -> IO (CmState, Maybe Type)
+          -> IO (CmState, Maybe (PrintUnqualified, Type))
 cmTypeExpr cmstate dflags modname expr
    = do (new_pcs, expr_type) <- 
 	   hscTypeExpr dflags hst hit pcs (mkHomeModule modname) expr
diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 0ea9799..5bd2ab1 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.10 2000/11/21 16:42:58 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.11 2000/11/22 10:56:53 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -43,10 +43,12 @@ ghciWelcomeMsg = "\
 
 commands :: [(String, String -> GHCi ())]
 commands = [
+  ("add",	addModule),
   ("cd",    	changeDirectory),
   ("help",	help),
   ("?",		help),
   ("load",	loadModule),
+  ("module",	setContext),
   ("reload",	reloadModule),
   ("set",	setOptions),
   ("type",	typeOfExpr),
@@ -57,11 +59,12 @@ shortHelpText = "use :? for help.\n"
 
 helpText = "\ 
 \   <expr>		evaluate <expr>\n\ 
+\   :add <filename>     add a module to the current set\n\ 
 \   :cd <dir>		change directory to <dir>\n\ 
-\   :help		display this list of commands\n\ 
-\   :?			display this list of commands\n\ 
+\   :help, :?		display this list of commands\n\ 
 \   :load <filename>    load a module (and it dependents)\n\ 
-\   :reload		reload the current program\n\ 
+\   :module <mod>	set the context for expression evaluation to <mod>\n\ 
+\   :reload		reload the current module set\n\ 
 \   :set <opetion> ...	set options\n\ 
 \   :type <expr>	show the type of <expr>\n\ 
 \   :quit		exit GHCi\n\ 
@@ -159,6 +162,18 @@ noArgs c = io (hPutStrLn stdout ("command `:" ++ c ++ "' takes no arguments"))
 help :: String -> GHCi ()
 help _ = io (putStr helpText)
 
+addModule :: String -> GHCi ()
+addModule _ = throwDyn (OtherError ":add not implemented")
+
+setContext :: String -> GHCi ()
+setContext ""
+  = throwDyn (OtherError "syntax: `:m <module>'")
+setContext m | not (isUpper (head m)) || not (all isAlphaNum (tail m))
+  = throwDyn (OtherError ("strange looking module name: `" ++ m ++ "'"))
+setContext m
+  = do st <- getGHCiState
+       setGHCiState st{current_module = mkModuleName m}
+
 changeDirectory :: String -> GHCi ()
 changeDirectory = io . setCurrentDirectory
 
@@ -225,7 +240,7 @@ typeOfExpr str
 				(current_module st) str)
        case maybe_ty of
 	 Nothing -> return ()
-	 Just ty -> io (putStrLn (showSDoc (ppr ty)))
+	 Just (unqual, ty) -> io (printForUser stdout unqual (ppr ty))
 
 quit :: String -> GHCi ()
 quit _ = exitGHCi
diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 8360fc0..206d478 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -484,13 +484,13 @@ hscTypeExpr
   -> PersistentCompilerState    -- IN: persistent compiler state
   -> Module			-- Context for compiling
   -> String			-- The expression
-  -> IO (PersistentCompilerState, Maybe Type)
+  -> IO (PersistentCompilerState, Maybe (PrintUnqualified, 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)
+	  Just (print_unqual,_,ty) -> return (pcs1, Just (print_unqual,ty))
 
 hscParseExpr :: DynFlags -> String -> IO (Maybe RdrNameHsExpr)
 hscParseExpr dflags str
-- 
1.7.10.4