[project @ 2003-02-24 12:39:24 by simonpj]

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

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index d4d994a..b8f75de 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,6 +1,6 @@
-{-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
+{-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.141 2002/12/19 15:12:01 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.148 2003/02/24 12:39:26 simonpj Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -26,10 +26,11 @@ import DriverUtil   ( remove_spaces, handle )
 import Linker          ( initLinker, showLinkerState, linkLibraries, 
                          linkPackages )
 import Util
-import Id              ( isRecordSelector, recordSelectorFieldLabel, 
-                         isDataConWrapId, isDataConId, idName )
+import IdInfo          ( GlobalIdDetails(..) )
+import Id              ( isImplicitId, idName, globalIdDetails )
 import Class           ( className )
 import TyCon           ( tyConName, tyConClass_maybe, isPrimTyCon, DataConDetails(..) )
+import DataCon         ( dataConName )
 import FieldLabel      ( fieldLabelTyCon )
 import SrcLoc          ( isGoodSrcLoc )
 import Module          ( showModMsg, lookupModuleEnv )
@@ -41,10 +42,10 @@ import Packages
 import Outputable
 import CmdLineOpts     ( DynFlag(..), DynFlags(..), getDynFlags, saveDynFlags,
                          restoreDynFlags, dopt_unset )
-import Panic           ( GhcException(..), showGhcException )
+import Panic           hiding ( showException )
 import Config
 
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
 import System.Posix
 #endif
 
@@ -88,14 +89,14 @@ GLOBAL_VAR(commands, builtin_commands, [(String, String -> GHCi Bool)])
 
 builtin_commands :: [(String, String -> GHCi Bool)]
 builtin_commands = [
-  ("add",      keepGoing addModule),
+  ("add",      keepGoingPaths addModule),
   ("browse",    keepGoing browseCmd),
   ("cd",       keepGoing changeDirectory),
   ("def",      keepGoing defineMacro),
   ("help",     keepGoing help),
   ("?",                keepGoing help),
   ("info",      keepGoing info),
-  ("load",     keepGoing loadModule),
+  ("load",     keepGoingPaths loadModule),
   ("module",   keepGoing setContext),
   ("reload",   keepGoing reloadModule),
   ("set",      keepGoing setCmd),
@@ -109,6 +110,9 @@ builtin_commands = [
 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
 keepGoing a str = a str >> return False
 
+keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
+keepGoingPaths a str = a (toArgs str) >> return False
+
 shortHelpText = "use :? for help.\n"
 
 -- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
@@ -227,10 +231,10 @@ runGHCi paths dflags = do
   -- perform a :load for files given on the GHCi command line
   when (not (null paths)) $
      ghciHandle showException $
-       loadModule (unwords paths)
+       loadModule paths
 
   -- enter the interactive loop
-#if defined(mingw32_TARGET_OS)
+#if defined(mingw32_HOST_OS)
    -- always show prompt, since hIsTerminalDevice returns True for Consoles
    -- only, which we may or may not be running under (cf. Emacs sub-shells.)
   interactiveLoop True
@@ -270,7 +274,7 @@ interactiveLoop is_tty = do
 
 checkPerms :: String -> IO Bool
 checkPerms name =
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
   return True
 #else
   DriverUtil.handle (\_ -> return False) $ do
@@ -352,6 +356,7 @@ runCommand c = ghciHandle handler (doCommand c)
 handler :: Exception -> GHCi Bool
 handler exception = do
   flushInterpBuffers
+  io installSignalHandlers
   ghciHandle handler (showException exception >> return False)
 
 showException (DynException dyn) =
@@ -393,6 +398,7 @@ finishEvalExpr names
       when b (mapM_ (showTypeOfName cmstate) names)
 
       flushInterpBuffers
+      io installSignalHandlers
       b <- isOptionSet RevertCAFs
       io (when b revertCAFs)
       return True
@@ -497,6 +503,8 @@ info s = do
 
     showTyThing (AClass cl)
        = hcat [ppr cl, text " is a class", showSrcLoc (className cl)]
+    showTyThing (ADataCon dc)
+       = hcat [ppr dc, text " is a data constructor", showSrcLoc (dataConName dc)]
     showTyThing (ATyCon ty)
        | isPrimTyCon ty
        = hcat [ppr ty, text " is a primitive type constructor"]
@@ -506,13 +514,10 @@ info s = do
        = hcat [ppr id, text " is a ", idDescr id, showSrcLoc (idName id)]
 
     idDescr id
-       | isRecordSelector id = 
-               case tyConClass_maybe (fieldLabelTyCon (
-                               recordSelectorFieldLabel id)) of
-                       Nothing -> text "record selector"
-                       Just c  -> text "method in class " <> ppr c
-       | isDataConWrapId id  = text "data constructor"
-       | otherwise           = text "variable"
+       = case globalIdDetails id of
+           RecordSelId lbl -> text "record selector for type" <+> ppr (fieldLabelTyCon lbl)
+           ClassOpId cls   -> text "method in class" <+> ppr cls
+                   otherwise       -> text "variable"
 
        -- also print out the source location for home things
     showSrcLoc name
@@ -526,9 +531,8 @@ info s = do
   setCmState cms
   return ()
 
-addModule :: String -> GHCi ()
-addModule str = do
-  let files = words str
+addModule :: [FilePath] -> GHCi ()
+addModule files = do
   state <- getGHCiState
   dflags <- io (getDynFlags)
   io (revertCAFs)                      -- always revert CAFs on load/add.
@@ -590,11 +594,11 @@ undefineMacro macro_name = do
   io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
 
 
-loadModule :: String -> GHCi ()
-loadModule str = timeIt (loadModule' str)
+loadModule :: [FilePath] -> GHCi ()
+loadModule fs = timeIt (loadModule' fs)
 
-loadModule' str = do
-  let files = words str
+loadModule' :: [FilePath] -> GHCi ()
+loadModule' files = do
   state <- getGHCiState
   dflags <- io getDynFlags
 
@@ -702,8 +706,9 @@ browseModule m exports_only = do
 
       things' = filter wantToSee things
 
-      wantToSee (AnId id) = not (isDataConId id || isDataConWrapId id)
-      wantToSee _ = True
+      wantToSee (AnId id)    = not (isImplicitId id)
+      wantToSee (ADataCon _) = False   -- They'll come via their TyCon
+      wantToSee _           = True
 
       thing_names = map getName things