ghc/compiler/ghci/InteractiveUI.hs

   1 {-# OPTIONS -#include "Linker.h" #-}
   2 -----------------------------------------------------------------------------
   3 --
   4 -- GHC Interactive User Interface
   5 --
   6 -- (c) The GHC Team 2005
   7 --
   8 -----------------------------------------------------------------------------
   9 module InteractiveUI (
  10         interactiveUI,
  11         ghciWelcomeMsg
  12    ) where
  13
  14 #include "HsVersions.h"
  15
  16 -- The GHC interface
  17 import qualified GHC
  18 import GHC              ( Session, verbosity, dopt, DynFlag(..),
  19                           mkModule, pprModule, Type, Module, SuccessFlag(..),
  20                           TyThing(..), Name, LoadHowMuch(..),
  21                           GhcException(..), showGhcException )
  22 import Outputable
  23
  24 -- following all needed for :info... ToDo: remove
  25 import IfaceSyn         ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecls(..),
  26                           IfaceConDecl(..), IfaceType,
  27                           pprIfaceDeclHead, pprParendIfaceType,
  28                           pprIfaceForAllPart, pprIfaceType )
  29 import FunDeps          ( pprFundeps )
  30 import SrcLoc           ( SrcLoc, pprDefnLoc )
  31 import OccName          ( OccName, parenSymOcc, occNameUserString )
  32 import BasicTypes       ( StrictnessMark(..), defaultFixity, failed )
  33
  34 -- Other random utilities
  35 import Panic            ( panic, installSignalHandlers )
  36 import Config
  37 import StaticFlags      ( opt_IgnoreDotGhci )
  38 import Linker           ( showLinkerState )
  39 import Util             ( removeSpaces, handle, global, toArgs,
  40                           looksLikeModuleName, prefixMatch )
  41
  42 #ifndef mingw32_HOST_OS
  43 import Util             ( handle )
  44 import System.Posix
  45 #if __GLASGOW_HASKELL__ > 504
  46         hiding (getEnv)
  47 #endif
  48 #else
  49 import GHC.ConsoleHandler ( flushConsole )
  50 #endif
  51
  52 #ifdef USE_READLINE
  53 import Control.Concurrent       ( yield )       -- Used in readline loop
  54 import System.Console.Readline as Readline
  55 #endif
  56
  57 --import SystemExts
  58
  59 import Control.Exception as Exception
  60 import Data.Dynamic
  61 -- import Control.Concurrent
  62
  63 import Numeric
  64 import Data.List
  65 import Data.Int         ( Int64 )
  66 import Data.Maybe       ( isJust )
  67 import System.Cmd
  68 import System.CPUTime
  69 import System.Environment
  70 import System.Exit      ( exitWith, ExitCode(..) )
  71 import System.Directory
  72 import System.IO
  73 import System.IO.Error as IO
  74 import Data.Char
  75 import Control.Monad as Monad
  76 import Foreign.StablePtr        ( newStablePtr )
  77
  78 import GHC.Exts         ( unsafeCoerce# )
  79 import GHC.IOBase       ( IOErrorType(InvalidArgument) )
  80
  81 import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )
  82
  83 import System.Posix.Internals ( setNonBlockingFD )
  84
  85 -----------------------------------------------------------------------------
  86
  87 ghciWelcomeMsg =
  88  "   ___         ___ _\n"++
  89  "  / _ \\ /\\  /\\/ __(_)\n"++
  90  " / /_\\// /_/ / /  | |      GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
  91  "/ /_\\\\/ __  / /___| |      http://www.haskell.org/ghc/\n"++
  92  "\\____/\\/ /_/\\____/|_|      Type :? for help.\n"
  93
  94 GLOBAL_VAR(commands, builtin_commands, [(String, String -> GHCi Bool)])
  95
  96 builtin_commands :: [(String, String -> GHCi Bool)]
  97 builtin_commands = [
  98   ("add",       keepGoingPaths addModule),
  99   ("browse",    keepGoing browseCmd),
 100   ("cd",        keepGoing changeDirectory),
 101   ("def",       keepGoing defineMacro),
 102   ("help",      keepGoing help),
 103   ("?",         keepGoing help),
 104   ("info",      keepGoing info),
 105   ("load",      keepGoingPaths loadModule_),
 106   ("module",    keepGoing setContext),
 107   ("reload",    keepGoing reloadModule),
 108   ("set",       keepGoing setCmd),
 109   ("show",      keepGoing showCmd),
 110   ("type",      keepGoing typeOfExpr),
 111   ("kind",      keepGoing kindOfType),
 112   ("unset",     keepGoing unsetOptions),
 113   ("undef",     keepGoing undefineMacro),
 114   ("quit",      quit)
 115   ]
 116
 117 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
 118 keepGoing a str = a str >> return False
 119
 120 keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
 121 keepGoingPaths a str = a (toArgs str) >> return False
 122
 123 shortHelpText = "use :? for help.\n"
 124
 125 -- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
 126 helpText =
 127  " Commands available from the prompt:\n" ++
 128  "\n" ++
 129  "   <stmt>                      evaluate/run <stmt>\n" ++
 130  "   :add <filename> ...         add module(s) to the current target set\n" ++
 131  "   :browse [*]<module>         display the names defined by <module>\n" ++
 132  "   :cd <dir>                   change directory to <dir>\n" ++
 133  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
 134  "   :help, :?                   display this list of commands\n" ++
 135  "   :info [<name> ...]          display information about the given names\n" ++
 136  "   :load <filename> ...        load module(s) and their dependents\n" ++
 137  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
 138  "   :reload                     reload the current module set\n" ++
 139  "\n" ++
 140  "   :set <option> ...           set options\n" ++
 141  "   :set args <arg> ...         set the arguments returned by System.getArgs\n" ++
 142  "   :set prog <progname>        set the value returned by System.getProgName\n" ++
 143  "\n" ++
 144  "   :show modules               show the currently loaded modules\n" ++
 145  "   :show bindings              show the current bindings made at the prompt\n" ++
 146  "\n" ++
 147  "   :type <expr>                show the type of <expr>\n" ++
 148  "   :kind <type>                show the kind of <type>\n" ++
 149  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
 150  "   :unset <option> ...         unset options\n" ++
 151  "   :quit                       exit GHCi\n" ++
 152  "   :!<command>                 run the shell command <command>\n" ++
 153  "\n" ++
 154  " Options for ':set' and ':unset':\n" ++
 155  "\n" ++
 156  "    +r            revert top-level expressions after each evaluation\n" ++
 157  "    +s            print timing/memory stats after each evaluation\n" ++
 158  "    +t            print type after evaluation\n" ++
 159  "    -<flags>      most GHC command line flags can also be set here\n" ++
 160  "                         (eg. -v2, -fglasgow-exts, etc.)\n"
 161
 162
 163 interactiveUI :: Session -> [FilePath] -> Maybe String -> IO ()
 164 interactiveUI session srcs maybe_expr = do
 165
 166    -- HACK! If we happen to get into an infinite loop (eg the user
 167    -- types 'let x=x in x' at the prompt), then the thread will block
 168    -- on a blackhole, and become unreachable during GC.  The GC will
 169    -- detect that it is unreachable and send it the NonTermination
 170    -- exception.  However, since the thread is unreachable, everything
 171    -- it refers to might be finalized, including the standard Handles.
 172    -- This sounds like a bug, but we don't have a good solution right
 173    -- now.
 174    newStablePtr stdin
 175    newStablePtr stdout
 176    newStablePtr stderr
 177
 178    hFlush stdout
 179    hSetBuffering stdout NoBuffering
 180
 181         -- Initialise buffering for the *interpreted* I/O system
 182    initInterpBuffering session
 183
 184         -- We don't want the cmd line to buffer any input that might be
 185         -- intended for the program, so unbuffer stdin.
 186    hSetBuffering stdin NoBuffering
 187
 188         -- initial context is just the Prelude
 189    GHC.setContext session [] [prelude_mod]
 190
 191 #ifdef USE_READLINE
 192    Readline.initialize
 193 #endif
 194
 195 #if defined(mingw32_HOST_OS)
 196     -- The win32 Console API mutates the first character of
 197     -- type-ahead when reading from it in a non-buffered manner. Work
 198     -- around this by flushing the input buffer of type-ahead characters.
 199     --
 200    GHC.ConsoleHandler.flushConsole stdin
 201 #endif
 202    startGHCi (runGHCi srcs maybe_expr)
 203         GHCiState{ progname = "<interactive>",
 204                    args = [],
 205                    session = session,
 206                    options = [] }
 207
 208 #ifdef USE_READLINE
 209    Readline.resetTerminal Nothing
 210 #endif
 211
 212    return ()
 213
 214 runGHCi :: [FilePath] -> Maybe String -> GHCi ()
 215 runGHCi paths maybe_expr = do
 216   let read_dot_files = not opt_IgnoreDotGhci
 217
 218   when (read_dot_files) $ do
 219     -- Read in ./.ghci.
 220     let file = "./.ghci"
 221     exists <- io (doesFileExist file)
 222     when exists $ do
 223        dir_ok  <- io (checkPerms ".")
 224        file_ok <- io (checkPerms file)
 225        when (dir_ok && file_ok) $ do
 226           either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
 227           case either_hdl of
 228              Left e    -> return ()
 229              Right hdl -> fileLoop hdl False
 230
 231   when (read_dot_files) $ do
 232     -- Read in $HOME/.ghci
 233     either_dir <- io (IO.try (getEnv "HOME"))
 234     case either_dir of
 235        Left e -> return ()
 236        Right dir -> do
 237           cwd <- io (getCurrentDirectory)
 238           when (dir /= cwd) $ do
 239              let file = dir ++ "/.ghci"
 240              ok <- io (checkPerms file)
 241              when ok $ do
 242                either_hdl <- io (IO.try (openFile file ReadMode))
 243                case either_hdl of
 244                   Left e    -> return ()
 245                   Right hdl -> fileLoop hdl False
 246
 247   -- Perform a :load for files given on the GHCi command line
 248   -- When in -e mode, if the load fails then we want to stop
 249   -- immediately rather than going on to evaluate the expression.
 250   when (not (null paths)) $ do
 251      ok <- ghciHandle (\e -> do showException e; return Failed) $
 252                 loadModule paths
 253      when (isJust maybe_expr && failed ok) $
 254         io (exitWith (ExitFailure 1))
 255
 256   -- if verbosity is greater than 0, or we are connected to a
 257   -- terminal, display the prompt in the interactive loop.
 258   is_tty <- io (hIsTerminalDevice stdin)
 259   dflags <- getDynFlags
 260   let show_prompt = verbosity dflags > 0 || is_tty
 261
 262   case maybe_expr of
 263         Nothing ->
 264             -- enter the interactive loop
 265             interactiveLoop is_tty show_prompt
 266         Just expr -> do
 267             -- just evaluate the expression we were given
 268             runCommandEval expr
 269             return ()
 270
 271   -- and finally, exit
 272   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 273
 274
 275 interactiveLoop is_tty show_prompt = do
 276   -- Ignore ^C exceptions caught here
 277   ghciHandleDyn (\e -> case e of
 278                         Interrupted -> ghciUnblock (
 279 #if defined(mingw32_HOST_OS)
 280                                                 io (putStrLn "") >>
 281 #endif
 282                                                 interactiveLoop is_tty show_prompt)
 283                         _other      -> return ()) $ do
 284
 285   -- read commands from stdin
 286 #ifdef USE_READLINE
 287   if (is_tty)
 288         then readlineLoop
 289         else fileLoop stdin show_prompt
 290 #else
 291   fileLoop stdin show_prompt
 292 #endif
 293
 294
 295 -- NOTE: We only read .ghci files if they are owned by the current user,
 296 -- and aren't world writable.  Otherwise, we could be accidentally
 297 -- running code planted by a malicious third party.
 298
 299 -- Furthermore, We only read ./.ghci if . is owned by the current user
 300 -- and isn't writable by anyone else.  I think this is sufficient: we
 301 -- don't need to check .. and ../.. etc. because "."  always refers to
 302 -- the same directory while a process is running.
 303
 304 checkPerms :: String -> IO Bool
 305 checkPerms name =
 306 #ifdef mingw32_HOST_OS
 307   return True
 308 #else
 309   Util.handle (\_ -> return False) $ do
 310      st <- getFileStatus name
 311      me <- getRealUserID
 312      if fileOwner st /= me then do
 313         putStrLn $ "WARNING: " ++ name ++ " is owned by someone else, IGNORING!"
 314         return False
 315       else do
 316         let mode =  fileMode st
 317         if (groupWriteMode == (mode `intersectFileModes` groupWriteMode))
 318            || (otherWriteMode == (mode `intersectFileModes` otherWriteMode))
 319            then do
 320                putStrLn $ "*** WARNING: " ++ name ++
 321                           " is writable by someone else, IGNORING!"
 322                return False
 323           else return True
 324 #endif
 325
 326 fileLoop :: Handle -> Bool -> GHCi ()
 327 fileLoop hdl prompt = do
 328    session <- getSession
 329    (mod,imports) <- io (GHC.getContext session)
 330    when prompt (io (putStr (mkPrompt mod imports)))
 331    l <- io (IO.try (hGetLine hdl))
 332    case l of
 333         Left e | isEOFError e              -> return ()
 334                | InvalidArgument <- etype  -> return ()
 335                | otherwise                 -> io (ioError e)
 336                 where etype = ioeGetErrorType e
 337                 -- treat InvalidArgument in the same way as EOF:
 338                 -- this can happen if the user closed stdin, or
 339                 -- perhaps did getContents which closes stdin at
 340                 -- EOF.
 341         Right l ->
 342           case removeSpaces l of
 343             "" -> fileLoop hdl prompt
 344             l  -> do quit <- runCommand l
 345                      if quit then return () else fileLoop hdl prompt
 346
 347 stringLoop :: [String] -> GHCi ()
 348 stringLoop [] = return ()
 349 stringLoop (s:ss) = do
 350    case removeSpaces s of
 351         "" -> stringLoop ss
 352         l  -> do quit <- runCommand l
 353                  if quit then return () else stringLoop ss
 354
 355 mkPrompt toplevs exports
 356   = showSDoc (hsep (map (\m -> char '*' <> pprModule m) toplevs)
 357              <+> hsep (map pprModule exports)
 358              <> text "> ")
 359
 360 #ifdef USE_READLINE
 361 readlineLoop :: GHCi ()
 362 readlineLoop = do
 363    session <- getSession
 364    (mod,imports) <- io (GHC.getContext session)
 365    io yield
 366    l <- io (readline (mkPrompt mod imports)
 367                 `finally` setNonBlockingFD 0)
 368                 -- readline sometimes puts stdin into blocking mode,
 369                 -- so we need to put it back for the IO library
 370    case l of
 371         Nothing -> return ()
 372         Just l  ->
 373           case removeSpaces l of
 374             "" -> readlineLoop
 375             l  -> do
 376                   io (addHistory l)
 377                   quit <- runCommand l
 378                   if quit then return () else readlineLoop
 379 #endif
 380
 381 runCommand :: String -> GHCi Bool
 382 runCommand c = ghciHandle handler (doCommand c)
 383
 384 -- This version is for the GHC command-line option -e.  The only difference
 385 -- from runCommand is that it catches the ExitException exception and
 386 -- exits, rather than printing out the exception.
 387 runCommandEval c = ghciHandle handleEval (doCommand c)
 388   where
 389     handleEval (ExitException code) = io (exitWith code)
 390     handleEval e                    = do showException e
 391                                          io (exitWith (ExitFailure 1))
 392
 393 -- This is the exception handler for exceptions generated by the
 394 -- user's code; it normally just prints out the exception.  The
 395 -- handler must be recursive, in case showing the exception causes
 396 -- more exceptions to be raised.
 397 --
 398 -- Bugfix: if the user closed stdout or stderr, the flushing will fail,
 399 -- raising another exception.  We therefore don't put the recursive
 400 -- handler arond the flushing operation, so if stderr is closed
 401 -- GHCi will just die gracefully rather than going into an infinite loop.
 402 handler :: Exception -> GHCi Bool
 403 handler exception = do
 404   flushInterpBuffers
 405   io installSignalHandlers
 406   ghciHandle handler (showException exception >> return False)
 407
 408 showException (DynException dyn) =
 409   case fromDynamic dyn of
 410     Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
 411     Just Interrupted      -> io (putStrLn "Interrupted.")
 412     Just (CmdLineError s) -> io (putStrLn s)     -- omit the location for CmdLineError
 413     Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
 414     Just other_ghc_ex     -> io (print other_ghc_ex)
 415
 416 showException other_exception
 417   = io (putStrLn ("*** Exception: " ++ show other_exception))
 418
 419 doCommand (':' : command) = specialCommand command
 420 doCommand stmt
 421    = do timeIt (do nms <- runStmt stmt; finishEvalExpr nms)
 422         return False
 423
 424 runStmt :: String -> GHCi [Name]
 425 runStmt stmt
 426  | null (filter (not.isSpace) stmt) = return []
 427  | otherwise
 428  = do st <- getGHCiState
 429       session <- getSession
 430       result <- io $ withProgName (progname st) $ withArgs (args st) $
 431                      GHC.runStmt session stmt
 432       case result of
 433         GHC.RunFailed      -> return []
 434         GHC.RunException e -> throw e  -- this is caught by runCommand(Eval)
 435         GHC.RunOk names    -> return names
 436
 437 -- possibly print the type and revert CAFs after evaluating an expression
 438 finishEvalExpr names
 439  = do b <- isOptionSet ShowType
 440       session <- getSession
 441       when b (mapM_ (showTypeOfName session) names)
 442
 443       flushInterpBuffers
 444       io installSignalHandlers
 445       b <- isOptionSet RevertCAFs
 446       io (when b revertCAFs)
 447       return True
 448
 449 showTypeOfName :: Session -> Name -> GHCi ()
 450 showTypeOfName session n
 451    = do maybe_tything <- io (GHC.lookupName session n)
 452         case maybe_tything of
 453           Nothing    -> return ()
 454           Just thing -> showTyThing thing
 455
 456 showForUser :: SDoc -> GHCi String
 457 showForUser doc = do
 458   session <- getSession
 459   unqual <- io (GHC.getPrintUnqual session)
 460   return $! showSDocForUser unqual doc
 461
 462 specialCommand :: String -> GHCi Bool
 463 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
 464 specialCommand str = do
 465   let (cmd,rest) = break isSpace str
 466   cmds <- io (readIORef commands)
 467   case [ (s,f) | (s,f) <- cmds, prefixMatch cmd s ] of
 468      []      -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
 469                                     ++ shortHelpText) >> return False)
 470      [(_,f)] -> f (dropWhile isSpace rest)
 471      cs      -> io (hPutStrLn stdout ("prefix " ++ cmd ++
 472                                       " matches multiple commands (" ++
 473                                        foldr1 (\a b -> a ++ ',':b) (map fst cs)
 474                                          ++ ")") >> return False)
 475
 476 noArgs c = throwDyn (CmdLineError ("command '" ++ c ++ "' takes no arguments"))
 477
 478
 479 -----------------------------------------------------------------------------
 480 -- To flush buffers for the *interpreted* computation we need
 481 -- to refer to *its* stdout/stderr handles
 482
 483 GLOBAL_VAR(flush_interp,       error "no flush_interp", IO ())
 484 GLOBAL_VAR(turn_off_buffering, error "no flush_stdout", IO ())
 485
 486 no_buf_cmd = "System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering" ++
 487              " Prelude.>> System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering"
 488 flush_cmd  = "System.IO.hFlush System.IO.stdout Prelude.>> System.IO.hFlush IO.stderr"
 489
 490 initInterpBuffering :: Session -> IO ()
 491 initInterpBuffering session
 492  = do maybe_hval <- GHC.compileExpr session no_buf_cmd
 493
 494       case maybe_hval of
 495         Just hval -> writeIORef turn_off_buffering (unsafeCoerce# hval :: IO ())
 496         other     -> panic "interactiveUI:setBuffering"
 497
 498       maybe_hval <- GHC.compileExpr session flush_cmd
 499       case maybe_hval of
 500         Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ())
 501         _         -> panic "interactiveUI:flush"
 502
 503       turnOffBuffering  -- Turn it off right now
 504
 505       return ()
 506
 507
 508 flushInterpBuffers :: GHCi ()
 509 flushInterpBuffers
 510  = io $ do Monad.join (readIORef flush_interp)
 511            return ()
 512
 513 turnOffBuffering :: IO ()
 514 turnOffBuffering
 515  = do Monad.join (readIORef turn_off_buffering)
 516       return ()
 517
 518 -----------------------------------------------------------------------------
 519 -- Commands
 520
 521 help :: String -> GHCi ()
 522 help _ = io (putStr helpText)
 523
 524 info :: String -> GHCi ()
 525 info "" = throwDyn (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
 526 info s  = do { let names = words s
 527              ; session <- getSession
 528              ; dflags <- getDynFlags
 529              ; let exts = dopt Opt_GlasgowExts dflags
 530              ; mapM_ (infoThing exts session) names }
 531   where
 532     infoThing exts session name
 533         = do { stuff <- io (GHC.getInfo session name)
 534              ; unqual <- io (GHC.getPrintUnqual session)
 535              ; io (putStrLn (showSDocForUser unqual $
 536                    vcat (intersperse (text "") (map (showThing exts) stuff)))) }
 537
 538 showThing :: Bool -> GHC.GetInfoResult -> SDoc
 539 showThing exts (wanted_str, thing, fixity, src_loc, insts)
 540     = vcat [ showWithLoc src_loc (showDecl exts want_name thing),
 541              show_fixity fixity,
 542              vcat (map show_inst insts)]
 543   where
 544     want_name occ = wanted_str == occNameUserString occ
 545
 546     show_fixity fix
 547         | fix == defaultFixity = empty
 548         | otherwise            = ppr fix <+> text wanted_str
 549
 550     show_inst (inst_ty, loc)
 551         = showWithLoc loc (ptext SLIT("instance") <+> ppr inst_ty)
 552
 553 showWithLoc :: SrcLoc -> SDoc -> SDoc
 554 showWithLoc loc doc
 555     = hang doc 2 (char '\t' <> comment <+> pprDefnLoc loc)
 556                 -- The tab tries to make them line up a bit
 557   where
 558     comment = ptext SLIT("--")
 559
 560
 561 -- Now there is rather a lot of goop just to print declarations in a
 562 -- civilised way with "..." for the parts we are less interested in.
 563
 564 showDecl :: Bool -> (OccName -> Bool) -> IfaceDecl -> SDoc
 565 showDecl exts want_name (IfaceForeign {ifName = tc})
 566   = ppr tc <+> ptext SLIT("is a foreign type")
 567
 568 showDecl exts want_name (IfaceId {ifName = var, ifType = ty})
 569   = ppr var <+> dcolon <+> showIfaceType exts ty
 570
 571 showDecl exts want_name (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifSynRhs = mono_ty})
 572   = hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
 573        2 (equals <+> ppr mono_ty)
 574
 575 showDecl exts want_name (IfaceData {ifName = tycon,
 576                      ifTyVars = tyvars, ifCons = condecls, ifCtxt = context})
 577   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
 578        2 (add_bars (ppr_trim show_con cs))
 579   where
 580     show_con (IfVanillaCon { ifConOcc = con_name, ifConInfix = is_infix, ifConArgTys = tys,
 581                              ifConStricts = strs, ifConFields = flds})
 582         | want_name tycon || want_name con_name || any want_name flds
 583         = Just (show_guts con_name is_infix tys_w_strs flds)
 584         | otherwise = Nothing
 585         where
 586           tys_w_strs = tys `zip` (strs ++ repeat NotMarkedStrict)
 587     show_con (IfGadtCon { ifConOcc = con_name, ifConTyVars = tvs, ifConCtxt = theta,
 588                           ifConArgTys = arg_tys, ifConResTys = res_tys, ifConStricts = strs })
 589         | want_name tycon || want_name con_name
 590         = Just (ppr_bndr con_name <+> colon <+> pprIfaceForAllPart tvs theta pp_tau)
 591         | otherwise = Nothing
 592         where
 593           tys_w_strs = arg_tys `zip` (strs ++ repeat NotMarkedStrict)
 594           pp_tau = foldr add pp_res_ty tys_w_strs
 595           pp_res_ty = ppr_bndr tycon <+> hsep (map pprParendIfaceType res_tys)
 596           add bty pp_ty = ppr_bangty bty <+> arrow <+> pp_ty
 597
 598     show_guts con True [ty1, ty2] flds = sep [ppr_bangty ty1, ppr con, ppr_bangty ty2]
 599     show_guts con _ tys []   = ppr_bndr con <+> sep (map ppr_bangty tys)
 600     show_guts con _ tys flds
 601         = ppr_bndr con <+> braces (sep (punctuate comma (ppr_trim show_fld (tys `zip` flds))))
 602         where
 603           show_fld (bty, fld) | want_name tycon || want_name con || want_name fld
 604                               = Just (ppr_bndr fld <+> dcolon <+> ppr_bangty bty)
 605                               | otherwise = Nothing
 606
 607     (pp_nd, cs) = case condecls of
 608                     IfAbstractTyCon        -> (ptext SLIT("data"),   [])
 609                     IfDataTyCon cs         -> (ptext SLIT("data"),   cs)
 610                     IfNewTyCon c           -> (ptext SLIT("newtype"),[c])
 611
 612     add_bars []      = empty
 613     add_bars [c]     = equals <+> c
 614     add_bars (c:cs)  = equals <+> sep (c : map (char '|' <+>) cs)
 615
 616     ppr_bangty (ty, str) = ppr_str str <> pprParendIfaceType ty
 617     ppr_str MarkedStrict    = char '!'
 618     ppr_str MarkedUnboxed   = ptext SLIT("!!")
 619     ppr_str NotMarkedStrict = empty
 620
 621 showDecl exts want_name (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
 622                       ifFDs = fds, ifSigs = sigs})
 623   = hang (ptext SLIT("class") <+> pprIfaceDeclHead context clas tyvars
 624                 <+> pprFundeps fds <+> opt_where)
 625        2 (vcat (ppr_trim show_op sigs))
 626   where
 627     opt_where | null sigs = empty
 628               | otherwise = ptext SLIT("where")
 629     show_op (IfaceClassOp op dm ty)
 630         | want_name clas || want_name op
 631         = Just (ppr_bndr op <+> dcolon <+> showIfaceType exts ty)
 632         | otherwise
 633         = Nothing
 634
 635 showIfaceType :: Bool -> IfaceType -> SDoc
 636 showIfaceType True  ty = pprIfaceType ty -- -fglasgow-exts: print with the foralls
 637 showIfaceType False ty = ppr ty     -- otherwise, print without the foralls
 638
 639 ppr_trim :: (a -> Maybe SDoc) -> [a] -> [SDoc]
 640 ppr_trim show xs
 641   = snd (foldr go (False, []) xs)
 642   where
 643     go x (eliding, so_far)
 644         | Just doc <- show x = (False, doc : so_far)
 645         | otherwise = if eliding then (True, so_far)
 646                                  else (True, ptext SLIT("...") : so_far)
 647
 648 ppr_bndr :: OccName -> SDoc
 649 -- Wrap operators in ()
 650 ppr_bndr occ = parenSymOcc occ (ppr occ)
 651
 652
 653 -----------------------------------------------------------------------------
 654 -- Commands
 655
 656 addModule :: [FilePath] -> GHCi ()
 657 addModule files = do
 658   io (revertCAFs)                       -- always revert CAFs on load/add.
 659   files <- mapM expandPath files
 660   targets <- mapM (io . GHC.guessTarget) files
 661   session <- getSession
 662   io (mapM_ (GHC.addTarget session) targets)
 663   ok <- io (GHC.load session LoadAllTargets)
 664   afterLoad ok session
 665
 666 changeDirectory :: String -> GHCi ()
 667 changeDirectory dir = do
 668   session <- getSession
 669   graph <- io (GHC.getModuleGraph session)
 670   when (not (null graph)) $
 671         io $ putStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
 672   io (GHC.setTargets session [])
 673   io (GHC.load session LoadAllTargets)
 674   setContextAfterLoad []
 675   io (GHC.workingDirectoryChanged session)
 676   dir <- expandPath dir
 677   io (setCurrentDirectory dir)
 678
 679 defineMacro :: String -> GHCi ()
 680 defineMacro s = do
 681   let (macro_name, definition) = break isSpace s
 682   cmds <- io (readIORef commands)
 683   if (null macro_name)
 684         then throwDyn (CmdLineError "invalid macro name")
 685         else do
 686   if (macro_name `elem` map fst cmds)
 687         then throwDyn (CmdLineError
 688                 ("command '" ++ macro_name ++ "' is already defined"))
 689         else do
 690
 691   -- give the expression a type signature, so we can be sure we're getting
 692   -- something of the right type.
 693   let new_expr = '(' : definition ++ ") :: String -> IO String"
 694
 695   -- compile the expression
 696   cms <- getSession
 697   maybe_hv <- io (GHC.compileExpr cms new_expr)
 698   case maybe_hv of
 699      Nothing -> return ()
 700      Just hv -> io (writeIORef commands --
 701                     ((macro_name, keepGoing (runMacro hv)) : cmds))
 702
 703 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi ()
 704 runMacro fun s = do
 705   str <- io ((unsafeCoerce# fun :: String -> IO String) s)
 706   stringLoop (lines str)
 707
 708 undefineMacro :: String -> GHCi ()
 709 undefineMacro macro_name = do
 710   cmds <- io (readIORef commands)
 711   if (macro_name `elem` map fst builtin_commands)
 712         then throwDyn (CmdLineError
 713                 ("command '" ++ macro_name ++ "' cannot be undefined"))
 714         else do
 715   if (macro_name `notElem` map fst cmds)
 716         then throwDyn (CmdLineError
 717                 ("command '" ++ macro_name ++ "' not defined"))
 718         else do
 719   io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
 720
 721
 722 loadModule :: [FilePath] -> GHCi SuccessFlag
 723 loadModule fs = timeIt (loadModule' fs)
 724
 725 loadModule_ :: [FilePath] -> GHCi ()
 726 loadModule_ fs = do loadModule fs; return ()
 727
 728 loadModule' :: [FilePath] -> GHCi SuccessFlag
 729 loadModule' files = do
 730   session <- getSession
 731
 732   -- unload first
 733   io (GHC.setTargets session [])
 734   io (GHC.load session LoadAllTargets)
 735
 736   -- expand tildes
 737   files <- mapM expandPath files
 738   targets <- io (mapM GHC.guessTarget files)
 739
 740   -- NOTE: we used to do the dependency anal first, so that if it
 741   -- fails we didn't throw away the current set of modules.  This would
 742   -- require some re-working of the GHC interface, so we'll leave it
 743   -- as a ToDo for now.
 744
 745   io (GHC.setTargets session targets)
 746   ok <- io (GHC.load session LoadAllTargets)
 747   afterLoad ok session
 748   return ok
 749
 750
 751 reloadModule :: String -> GHCi ()
 752 reloadModule "" = do
 753   io (revertCAFs)               -- always revert CAFs on reload.
 754   session <- getSession
 755   ok <- io (GHC.load session LoadAllTargets)
 756   afterLoad ok session
 757 reloadModule m = do
 758   io (revertCAFs)               -- always revert CAFs on reload.
 759   session <- getSession
 760   ok <- io (GHC.load session (LoadUpTo (mkModule m)))
 761   afterLoad ok session
 762
 763 afterLoad ok session = do
 764   io (revertCAFs)  -- always revert CAFs on load.
 765   graph <- io (GHC.getModuleGraph session)
 766   let mods = map GHC.ms_mod graph
 767   mods' <- filterM (io . GHC.isLoaded session) mods
 768   setContextAfterLoad mods'
 769   modulesLoadedMsg ok mods'
 770
 771 setContextAfterLoad [] = do
 772   session <- getSession
 773   io (GHC.setContext session [] [prelude_mod])
 774 setContextAfterLoad (m:_) = do
 775   session <- getSession
 776   b <- io (GHC.moduleIsInterpreted session m)
 777   if b then io (GHC.setContext session [m] [])
 778        else io (GHC.setContext session []  [m])
 779
 780 modulesLoadedMsg :: SuccessFlag -> [Module] -> GHCi ()
 781 modulesLoadedMsg ok mods = do
 782   dflags <- getDynFlags
 783   when (verbosity dflags > 0) $ do
 784    let mod_commas
 785         | null mods = text "none."
 786         | otherwise = hsep (
 787             punctuate comma (map pprModule mods)) <> text "."
 788    case ok of
 789     Failed ->
 790        io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
 791     Succeeded  ->
 792        io (putStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)))
 793
 794
 795 typeOfExpr :: String -> GHCi ()
 796 typeOfExpr str
 797   = do cms <- getSession
 798        maybe_ty <- io (GHC.exprType cms str)
 799        case maybe_ty of
 800           Nothing -> return ()
 801           Just ty -> do ty' <- cleanType ty
 802                         tystr <- showForUser (ppr ty')
 803                         io (putStrLn (str ++ " :: " ++ tystr))
 804
 805 kindOfType :: String -> GHCi ()
 806 kindOfType str
 807   = do cms <- getSession
 808        maybe_ty <- io (GHC.typeKind cms str)
 809        case maybe_ty of
 810           Nothing    -> return ()
 811           Just ty    -> do tystr <- showForUser (ppr ty)
 812                            io (putStrLn (str ++ " :: " ++ tystr))
 813
 814 quit :: String -> GHCi Bool
 815 quit _ = return True
 816
 817 shellEscape :: String -> GHCi Bool
 818 shellEscape str = io (system str >> return False)
 819
 820 -----------------------------------------------------------------------------
 821 -- Browsing a module's contents
 822
 823 browseCmd :: String -> GHCi ()
 824 browseCmd m =
 825   case words m of
 826     ['*':m] | looksLikeModuleName m -> browseModule m False
 827     [m]     | looksLikeModuleName m -> browseModule m True
 828     _ -> throwDyn (CmdLineError "syntax:  :browse <module>")
 829
 830 browseModule m exports_only = do
 831   s <- getSession
 832
 833   let modl = mkModule m
 834   is_interpreted <- io (GHC.moduleIsInterpreted s modl)
 835   when (not is_interpreted && not exports_only) $
 836         throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted"))
 837
 838   -- Temporarily set the context to the module we're interested in,
 839   -- just so we can get an appropriate PrintUnqualified
 840   (as,bs) <- io (GHC.getContext s)
 841   io (if exports_only then GHC.setContext s [] [prelude_mod,modl]
 842                       else GHC.setContext s [modl] [])
 843   io (GHC.setContext s as bs)
 844
 845   things <- io (GHC.browseModule s modl exports_only)
 846   unqual <- io (GHC.getPrintUnqual s)
 847
 848   dflags <- getDynFlags
 849   let exts = dopt Opt_GlasgowExts dflags
 850   io (putStrLn (showSDocForUser unqual (
 851          vcat (map (showDecl exts (const True)) things)
 852       )))
 853
 854 -----------------------------------------------------------------------------
 855 -- Setting the module context
 856
 857 setContext str
 858   | all sensible mods = fn mods
 859   | otherwise = throwDyn (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
 860   where
 861     (fn, mods) = case str of
 862                         '+':stuff -> (addToContext,      words stuff)
 863                         '-':stuff -> (removeFromContext, words stuff)
 864                         stuff     -> (newContext,        words stuff)
 865
 866     sensible ('*':m) = looksLikeModuleName m
 867     sensible m       = looksLikeModuleName m
 868
 869 newContext mods = do
 870   session <- getSession
 871   (as,bs) <- separate session mods [] []
 872   let bs' = if null as && prelude_mod `notElem` bs then prelude_mod:bs else bs
 873   io (GHC.setContext session as bs')
 874
 875 separate :: Session -> [String] -> [Module] -> [Module]
 876   -> GHCi ([Module],[Module])
 877 separate session []           as bs = return (as,bs)
 878 separate session (('*':m):ms) as bs = do
 879    let modl = mkModule m
 880    b <- io (GHC.moduleIsInterpreted session modl)
 881    if b then separate session ms (modl:as) bs
 882         else throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted"))
 883 separate session (m:ms)       as bs = separate session ms as (mkModule m:bs)
 884
 885 prelude_mod = mkModule "Prelude"
 886
 887
 888 addToContext mods = do
 889   cms <- getSession
 890   (as,bs) <- io (GHC.getContext cms)
 891
 892   (as',bs') <- separate cms mods [] []
 893
 894   let as_to_add = as' \\ (as ++ bs)
 895       bs_to_add = bs' \\ (as ++ bs)
 896
 897   io (GHC.setContext cms (as ++ as_to_add) (bs ++ bs_to_add))
 898
 899
 900 removeFromContext mods = do
 901   cms <- getSession
 902   (as,bs) <- io (GHC.getContext cms)
 903
 904   (as_to_remove,bs_to_remove) <- separate cms mods [] []
 905
 906   let as' = as \\ (as_to_remove ++ bs_to_remove)
 907       bs' = bs \\ (as_to_remove ++ bs_to_remove)
 908
 909   io (GHC.setContext cms as' bs')
 910
 911 ----------------------------------------------------------------------------
 912 -- Code for `:set'
 913
 914 -- set options in the interpreter.  Syntax is exactly the same as the
 915 -- ghc command line, except that certain options aren't available (-C,
 916 -- -E etc.)
 917 --
 918 -- This is pretty fragile: most options won't work as expected.  ToDo:
 919 -- figure out which ones & disallow them.
 920
 921 setCmd :: String -> GHCi ()
 922 setCmd ""
 923   = do st <- getGHCiState
 924        let opts = options st
 925        io $ putStrLn (showSDoc (
 926               text "options currently set: " <>
 927               if null opts
 928                    then text "none."
 929                    else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
 930            ))
 931 setCmd str
 932   = case words str of
 933         ("args":args) -> setArgs args
 934         ("prog":prog) -> setProg prog
 935         wds -> setOptions wds
 936
 937 setArgs args = do
 938   st <- getGHCiState
 939   setGHCiState st{ args = args }
 940
 941 setProg [prog] = do
 942   st <- getGHCiState
 943   setGHCiState st{ progname = prog }
 944 setProg _ = do
 945   io (hPutStrLn stderr "syntax: :set prog <progname>")
 946
 947 setOptions wds =
 948    do -- first, deal with the GHCi opts (+s, +t, etc.)
 949       let (plus_opts, minus_opts)  = partition isPlus wds
 950       mapM_ setOpt plus_opts
 951
 952       -- then, dynamic flags
 953       dflags <- getDynFlags
 954       (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts
 955       setDynFlags dflags'
 956
 957         -- update things if the users wants more packages
 958 {- TODO:
 959         let new_packages = pkgs_after \\ pkgs_before
 960         when (not (null new_packages)) $
 961            newPackages new_packages
 962 -}
 963
 964       if (not (null leftovers))
 965                 then throwDyn (CmdLineError ("unrecognised flags: " ++
 966                                                 unwords leftovers))
 967                 else return ()
 968
 969
 970 unsetOptions :: String -> GHCi ()
 971 unsetOptions str
 972   = do -- first, deal with the GHCi opts (+s, +t, etc.)
 973        let opts = words str
 974            (minus_opts, rest1) = partition isMinus opts
 975            (plus_opts, rest2)  = partition isPlus rest1
 976
 977        if (not (null rest2))
 978           then io (putStrLn ("unknown option: '" ++ head rest2 ++ "'"))
 979           else do
 980
 981        mapM_ unsetOpt plus_opts
 982
 983        -- can't do GHC flags for now
 984        if (not (null minus_opts))
 985           then throwDyn (CmdLineError "can't unset GHC command-line flags")
 986           else return ()
 987
 988 isMinus ('-':s) = True
 989 isMinus _ = False
 990
 991 isPlus ('+':s) = True
 992 isPlus _ = False
 993
 994 setOpt ('+':str)
 995   = case strToGHCiOpt str of
 996         Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
 997         Just o  -> setOption o
 998
 999 unsetOpt ('+':str)
1000   = case strToGHCiOpt str of
1001         Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
1002         Just o  -> unsetOption o
1003
1004 strToGHCiOpt :: String -> (Maybe GHCiOption)
1005 strToGHCiOpt "s" = Just ShowTiming
1006 strToGHCiOpt "t" = Just ShowType
1007 strToGHCiOpt "r" = Just RevertCAFs
1008 strToGHCiOpt _   = Nothing
1009
1010 optToStr :: GHCiOption -> String
1011 optToStr ShowTiming = "s"
1012 optToStr ShowType   = "t"
1013 optToStr RevertCAFs = "r"
1014
1015 {- ToDo
1016 newPackages new_pkgs = do       -- The new packages are already in v_Packages
1017   session <- getSession
1018   io (GHC.setTargets session [])
1019   io (GHC.load session Nothing)
1020   dflags   <- getDynFlags
1021   io (linkPackages dflags new_pkgs)
1022   setContextAfterLoad []
1023 -}
1024
1025 -- ---------------------------------------------------------------------------
1026 -- code for `:show'
1027
1028 showCmd str =
1029   case words str of
1030         ["modules" ] -> showModules
1031         ["bindings"] -> showBindings
1032         ["linker"]   -> io showLinkerState
1033         _ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings]")
1034
1035 showModules = do
1036   session <- getSession
1037   let show_one ms = do m <- io (GHC.showModule session ms)
1038                        io (putStrLn m)
1039   graph <- io (GHC.getModuleGraph session)
1040   mapM_ show_one graph
1041
1042 showBindings = do
1043   s <- getSession
1044   unqual <- io (GHC.getPrintUnqual s)
1045   bindings <- io (GHC.getBindings s)
1046   mapM_ showTyThing bindings
1047   return ()
1048
1049 showTyThing (AnId id) = do
1050   ty' <- cleanType (GHC.idType id)
1051   str <- showForUser (ppr id <> text " :: " <> ppr ty')
1052   io (putStrLn str)
1053 showTyThing _  = return ()
1054
1055 -- if -fglasgow-exts is on we show the foralls, otherwise we don't.
1056 cleanType :: Type -> GHCi Type
1057 cleanType ty = do
1058   dflags <- getDynFlags
1059   if dopt Opt_GlasgowExts dflags
1060         then return ty
1061         else return $! GHC.dropForAlls ty
1062
1063 -----------------------------------------------------------------------------
1064 -- GHCi monad
1065
1066 data GHCiState = GHCiState
1067      {
1068         progname       :: String,
1069         args           :: [String],
1070         session        :: GHC.Session,
1071         options        :: [GHCiOption]
1072      }
1073
1074 data GHCiOption
1075         = ShowTiming            -- show time/allocs after evaluation
1076         | ShowType              -- show the type of expressions
1077         | RevertCAFs            -- revert CAFs after every evaluation
1078         deriving Eq
1079
1080 newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> IO a }
1081
1082 startGHCi :: GHCi a -> GHCiState -> IO a
1083 startGHCi g state = do ref <- newIORef state; unGHCi g ref
1084
1085 instance Monad GHCi where
1086   (GHCi m) >>= k  =  GHCi $ \s -> m s >>= \a -> unGHCi (k a) s
1087   return a  = GHCi $ \s -> return a
1088
1089 ghciHandleDyn :: Typeable t => (t -> GHCi a) -> GHCi a -> GHCi a
1090 ghciHandleDyn h (GHCi m) = GHCi $ \s ->
1091    Exception.catchDyn (m s) (\e -> unGHCi (h e) s)
1092
1093 getGHCiState   = GHCi $ \r -> readIORef r
1094 setGHCiState s = GHCi $ \r -> writeIORef r s
1095
1096 -- for convenience...
1097 getSession = getGHCiState >>= return . session
1098
1099 getDynFlags = do
1100   s <- getSession
1101   io (GHC.getSessionDynFlags s)
1102 setDynFlags dflags = do
1103   s <- getSession
1104   io (GHC.setSessionDynFlags s dflags)
1105
1106 isOptionSet :: GHCiOption -> GHCi Bool
1107 isOptionSet opt
1108  = do st <- getGHCiState
1109       return (opt `elem` options st)
1110
1111 setOption :: GHCiOption -> GHCi ()
1112 setOption opt
1113  = do st <- getGHCiState
1114       setGHCiState (st{ options = opt : filter (/= opt) (options st) })
1115
1116 unsetOption :: GHCiOption -> GHCi ()
1117 unsetOption opt
1118  = do st <- getGHCiState
1119       setGHCiState (st{ options = filter (/= opt) (options st) })
1120
1121 io :: IO a -> GHCi a
1122 io m = GHCi { unGHCi = \s -> m >>= return }
1123
1124 -----------------------------------------------------------------------------
1125 -- recursive exception handlers
1126
1127 -- Don't forget to unblock async exceptions in the handler, or if we're
1128 -- in an exception loop (eg. let a = error a in a) the ^C exception
1129 -- may never be delivered.  Thanks to Marcin for pointing out the bug.
1130
1131 ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
1132 ghciHandle h (GHCi m) = GHCi $ \s ->
1133    Exception.catch (m s)
1134         (\e -> unGHCi (ghciUnblock (h e)) s)
1135
1136 ghciUnblock :: GHCi a -> GHCi a
1137 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
1138
1139 -----------------------------------------------------------------------------
1140 -- timing & statistics
1141
1142 timeIt :: GHCi a -> GHCi a
1143 timeIt action
1144   = do b <- isOptionSet ShowTiming
1145        if not b
1146           then action
1147           else do allocs1 <- io $ getAllocations
1148                   time1   <- io $ getCPUTime
1149                   a <- action
1150                   allocs2 <- io $ getAllocations
1151                   time2   <- io $ getCPUTime
1152                   io $ printTimes (fromIntegral (allocs2 - allocs1))
1153                                   (time2 - time1)
1154                   return a
1155
1156 foreign import ccall unsafe "getAllocations" getAllocations :: IO Int64
1157         -- defined in ghc/rts/Stats.c
1158
1159 printTimes :: Integer -> Integer -> IO ()
1160 printTimes allocs psecs
1161    = do let secs = (fromIntegral psecs / (10^12)) :: Float
1162             secs_str = showFFloat (Just 2) secs
1163         putStrLn (showSDoc (
1164                  parens (text (secs_str "") <+> text "secs" <> comma <+>
1165                          text (show allocs) <+> text "bytes")))
1166
1167 -----------------------------------------------------------------------------
1168 -- reverting CAFs
1169
1170 revertCAFs :: IO ()
1171 revertCAFs = do
1172   rts_revertCAFs
1173   turnOffBuffering
1174         -- Have to turn off buffering again, because we just
1175         -- reverted stdout, stderr & stdin to their defaults.
1176
1177 foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()
1178         -- Make it "safe", just in case
1179
1180 -- -----------------------------------------------------------------------------
1181 -- Utils
1182
1183 expandPath :: String -> GHCi String
1184 expandPath path =
1185   case dropWhile isSpace path of
1186    ('~':d) -> do
1187         tilde <- io (getEnv "HOME")     -- will fail if HOME not defined
1188         return (tilde ++ '/':d)
1189    other ->
1190         return other