-----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.83 2001/07/24 04:41:40 ken Exp $
+-- $Id: InteractiveUI.hs,v 1.88 2001/08/15 15:39:59 simonmar Exp $
--
-- GHC Interactive User Interface
--
import Packages
import CompManager
-import HscTypes ( GhciMode(..) )
+import HscTypes ( GhciMode(..), TyThing(..) )
import MkIface ( ifaceTyCls )
import ByteCodeLink
import DriverFlags
import Linker
import Finder ( flushPackageCache )
import Util
-import Name ( Name )
+import Id ( isRecordSelector, isDataConWrapId, idName )
+import Class ( className )
+import TyCon ( tyConName )
+import SrcLoc ( isGoodSrcLoc )
+import Name ( Name, isHomePackageName, nameSrcLoc )
import Outputable
import CmdLineOpts ( DynFlag(..), getDynFlags, saveDynFlags, restoreDynFlags, dopt_unset )
import Panic ( GhcException(..) )
\ :cd <dir> change directory to <dir>\n\
\ :def <cmd> <expr> define a command :<cmd>\n\
\ :help, :? display this list of commands\n\
-\ :info [<name> ...] display information about the given names, or\n\
-\ about currently loaded files if no names given\n\
+\ :info [<name> ...] display information about the given names\n\
\ :load <filename> ... load module(s) and their dependents\n\
\ :module <mod> set the context for expression evaluation to <mod>\n\
\ :reload reload the current module set\n\
runGHCi :: GHCi ()
runGHCi = do
- -- Read in ./.ghci.
- let file = "./.ghci"
- exists <- io (doesFileExist file)
- when exists $ do
- dir_ok <- io (checkPerms ".")
- file_ok <- io (checkPerms file)
- when (dir_ok && file_ok) $ do
- either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
- case either_hdl of
- Left e -> return ()
- Right hdl -> fileLoop hdl False
-
- -- Read in $HOME/.ghci
- either_dir <- io (IO.try (getEnv "HOME"))
- case either_dir of
- Left e -> return ()
- Right dir -> do
- cwd <- io (getCurrentDirectory)
- when (dir /= cwd) $ do
- let file = dir ++ "/.ghci"
- ok <- io (checkPerms file)
- either_hdl <- io (IO.try (openFile file ReadMode))
- case either_hdl of
- Left e -> return ()
- Right hdl -> fileLoop hdl False
+ read_dot_files <- io (readIORef v_Read_DotGHCi)
+
+ when (read_dot_files) $ do
+ -- Read in ./.ghci.
+ let file = "./.ghci"
+ exists <- io (doesFileExist file)
+ when exists $ do
+ dir_ok <- io (checkPerms ".")
+ file_ok <- io (checkPerms file)
+ when (dir_ok && file_ok) $ do
+ either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
+ case either_hdl of
+ Left e -> return ()
+ Right hdl -> fileLoop hdl False
+
+ when (read_dot_files) $ do
+ -- Read in $HOME/.ghci
+ either_dir <- io (IO.try (getEnv "HOME"))
+ case either_dir of
+ Left e -> return ()
+ Right dir -> do
+ cwd <- io (getCurrentDirectory)
+ when (dir /= cwd) $ do
+ let file = dir ++ "/.ghci"
+ ok <- io (checkPerms file)
+ when ok $ do
+ either_hdl <- io (IO.try (openFile file ReadMode))
+ case either_hdl of
+ Left e -> return ()
+ Right hdl -> fileLoop hdl False
-- read commands from stdin
#if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
help _ = io (putStr helpText)
info :: String -> GHCi ()
-info "" = do io (putStr "dunno, mate")
+info "" = throwDyn (CmdLineError "syntax: `:i <thing-you-want-info-about>'")
info s = do
let names = words s
- st <- getGHCiState
- let cmst = cmstate st
+ state <- getGHCiState
dflags <- io getDynFlags
- things <- io (mapM (cmInfoThing cmst dflags) names)
- let real_things = [ x | Just x <- things ]
- let descs = map (`ifaceTyCls` []) real_things
- let strings = map (showSDoc . ppr) descs
- io (mapM_ putStr strings)
+ let
+ infoThings cms [] = return cms
+ infoThings cms (name:names) = do
+ (cms, unqual, ty_things) <- io (cmInfoThing cms dflags name)
+ io (putStrLn (showSDocForUser unqual (
+ vcat (intersperse (text "") (map showThing ty_things))))
+ )
+ infoThings cms names
+
+ showThing ty_thing = vcat [ text "-- " <> showTyThing ty_thing,
+ ppr (ifaceTyCls ty_thing) ]
+
+ showTyThing (AClass cl)
+ = hcat [ppr cl, text " is a class", showSrcLoc (className cl)]
+ showTyThing (ATyCon ty)
+ = hcat [ppr ty, text " is a type constructor", showSrcLoc (tyConName ty)]
+ showTyThing (AnId id)
+ = hcat [ppr id, text " is a ", text (idDescr id), showSrcLoc (idName id)]
+
+ idDescr id
+ | isRecordSelector id = "record selector"
+ | isDataConWrapId id = "data constructor"
+ | otherwise = "variable"
+
+ -- also print out the source location for home things
+ showSrcLoc name
+ | isHomePackageName name && isGoodSrcLoc loc
+ = hsep [ text ", defined at", ppr loc ]
+ | otherwise
+ = empty
+ where loc = nameSrcLoc name
+
+ cms <- infoThings (cmstate state) names
+ setGHCiState state{ cmstate = cms }
+ return ()
+
addModule :: String -> GHCi ()
addModule str = do
= do sequence_ [ linkPackage (name p `elem` loaded) p | p <- reverse pkgs ]
lib_paths <- readIORef v_Library_paths
mapM_ (preloadLib lib_paths) cmdline_lib_specs
+ if (null cmdline_lib_specs)
+ then return ()
+ else do putStr "final link ... "
+ ok <- resolveObjs
+ if ok then putStrLn "done."
+ else throwDyn (InstallationError "linking extra libraries/objects failed")
where
-- Packages that are already linked into GHCi. For mingw32, we only
-- skip gmp and rts, since std and after need to load the msvcrt.dll
case lib_spec of
Left static_ish
-> do b <- preload_static lib_paths static_ish
- putStrLn (if b then "done" else "not found")
+ putStrLn (if b then "done." else "not found")
Right dll_unadorned
-> -- We add "" to the set of paths to try, so that
-- if none of the real paths match, we force addDLL
mapM loadClassified sos_first
putStr "linking ... "
- resolveObjs
- putStrLn "done."
+ ok <- resolveObjs
+ if ok then putStrLn "done."
+ else panic ("can't load package `" ++ name pkg ++ "'")
where
isRight (Right _) = True
isRight (Left _) = False
projects / ghc-hetmet.git / blobdiff