Commit af953214 authored by Simon Marlow's avatar Simon Marlow

refactor: move pprintClosureCommand out of the GHCi monad

Strictly speaking most of pprintClosureCommand should be exported by
the GHC API, but this is a step in the right direction.
parent 671b39c5
......@@ -15,7 +15,6 @@ module Debugger (pprintClosureCommand) where
import Linker
import RtClosureInspect
import PrelNames
import HscTypes
import IdInfo
--import Id
......@@ -23,15 +22,11 @@ import Var hiding ( varName )
import VarSet
import VarEnv
import Name
import NameEnv
import RdrName
import UniqSupply
import Type
import TcType
import TyCon
import TcGadt
import GHC
import GhciMonad
import Outputable
import Pretty ( Mode(..), showDocWith )
......@@ -52,16 +47,15 @@ import GHC.Exts
-------------------------------------
-- | The :print & friends commands
-------------------------------------
pprintClosureCommand :: Bool -> Bool -> String -> GHCi ()
pprintClosureCommand bindThings force str = do
cms <- getSession
pprintClosureCommand :: Session -> Bool -> Bool -> String -> IO ()
pprintClosureCommand session bindThings force str = do
tythings <- (catMaybes . concat) `liftM`
mapM (\w -> io(GHC.parseName cms w >>=
mapM (GHC.lookupName cms)))
mapM (\w -> GHC.parseName session w >>=
mapM (GHC.lookupName session))
(words str)
substs <- catMaybes `liftM` mapM (io . go cms)
substs <- catMaybes `liftM` mapM (go session)
[id | AnId id <- tythings]
mapM (io . applySubstToEnv cms . skolemSubst) substs
mapM (applySubstToEnv session . skolemSubst) substs
return ()
where
......
......@@ -15,13 +15,13 @@ module InteractiveUI (
import GhciMonad
import GhciTags
import Debugger
-- The GHC interface
import qualified GHC
import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..),
Type, Module, ModuleName, TyThing(..), Phase,
BreakIndex, Name, SrcSpan )
import Debugger
import DynFlags
import Packages
import PackageConfig
......@@ -114,7 +114,7 @@ builtin_commands = [
("e", keepGoing editFile, False, completeFilename),
("edit", keepGoing editFile, False, completeFilename),
("etags", keepGoing createETagsFileCmd, False, completeFilename),
("force", keepGoing (pprintClosureCommand False True), False, completeIdentifier),
("force", keepGoing forceCmd, False, completeIdentifier),
("help", keepGoing help, False, completeNone),
("info", keepGoing info, False, completeIdentifier),
("kind", keepGoing kindOfType, False, completeIdentifier),
......@@ -122,12 +122,12 @@ builtin_commands = [
("list", keepGoing listCmd, False, completeNone),
("module", keepGoing setContext, False, completeModule),
("main", keepGoing runMain, False, completeIdentifier),
("print", keepGoing (pprintClosureCommand True False), False, completeIdentifier),
("print", keepGoing printCmd, False, completeIdentifier),
("quit", quit, False, completeNone),
("reload", keepGoing reloadModule, False, completeNone),
("set", keepGoing setCmd, True, completeSetOptions),
("show", keepGoing showCmd, False, completeNone),
("sprint", keepGoing (pprintClosureCommand False False),False, completeIdentifier),
("sprint", keepGoing sprintCmd, False, completeIdentifier),
("step", stepCmd, False, completeIdentifier),
("type", keepGoing typeOfExpr, False, completeIdentifier),
("undef", keepGoing undefineMacro, False, completeMacro),
......@@ -1356,6 +1356,14 @@ setUpConsole = do
-- -----------------------------------------------------------------------------
-- commands for debugger
sprintCmd = pprintCommand False False
printCmd = pprintCommand True False
forceCmd = pprintCommand False True
pprintCommand bind force str = do
session <- getSession
io $ pprintClosureCommand session bind force str
foreign import ccall "rts_setStepFlag" setStepFlag :: IO ()
stepCmd :: String -> GHCi Bool
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment