summaryrefslogtreecommitdiff
path: root/compiler/ghci/Debugger.hs
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2007-04-18 11:47:00 +0000
committerSimon Marlow <simonmar@microsoft.com>2007-04-18 11:47:00 +0000
commit38e7ac3ffa32d75c1922e7247a910e06d9957116 (patch)
treedeb72eb3adc4dc2252c4784932aa6e5da7924ace /compiler/ghci/Debugger.hs
parent71f74505bed49cf595bc9df3d1ba050448793c92 (diff)
downloadhaskell-38e7ac3ffa32d75c1922e7247a910e06d9957116.tar.gz
Various cleanups and improvements to the breakpoint support
- move parts of the debugger implementation below the GHC API where they belong. There is still more in Debugger that violates the layering, hopefully I'll get to that later. - instead of returning an IO action from runStmt for resuming, return a ResumeHandle that is passed to GHC.resume. - breakpoints now return [Name] which is displayed in the same way as when a binding statement is executed. - :load, :add, :reload now clear the active breakpoints and context - :break gives a sensible error when used on a non-interpreted module - export breakpoint-related types from GHC - remove a bunch of layer-violating imports from InteractiveUI - remove some more vestiges of the old breakpoint code (topLevel in the GHCi state). - remove TickTree and use a simple array instead, cached per module
Diffstat (limited to 'compiler/ghci/Debugger.hs')
-rw-r--r--compiler/ghci/Debugger.hs63
1 files changed, 11 insertions, 52 deletions
diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index f0f8973033..4389213849 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -4,10 +4,15 @@
--
-- Pepe Iborra (supported by Google SoC) 2006
--
+-- ToDo: lots of violation of layering here. This module should
+-- decide whether it is above the GHC API (import GHC and nothing
+-- else) or below it.
+--
-----------------------------------------------------------------------------
-module Debugger (pprintClosureCommand, instantiateTyVarsToUnknown) where
+module Debugger (pprintClosureCommand) where
+import qualified DebuggerTys
import Linker
import RtClosureInspect
@@ -24,7 +29,6 @@ import RdrName
import UniqSupply
import Type
import TyCon
-import DataCon
import TcGadt
import GHC
import GhciMonad
@@ -203,56 +207,6 @@ newGrimName cms userName = do
name = mkInternalName unique occname noSrcLoc
return name
-----------------------------------------------------------------------------
--- | Replace all the tyvars in a Term with the opaque type GHC.Base.Unknown
-----------------------------------------------------------------------------
-instantiateTyVarsToUnknown :: Session -> Type -> IO Type
-instantiateTyVarsToUnknown cms ty
--- We have a GADT, so just fix its tyvars
- | Just (tycon, args) <- splitTyConApp_maybe ty
- , tycon /= funTyCon
- , isGADT tycon
- = mapM fixTyVars args >>= return . mkTyConApp tycon
--- We have a regular TyCon, so map recursively to its args
- | Just (tycon, args) <- splitTyConApp_maybe ty
- , tycon /= funTyCon
- = do unknownTyVar <- unknownTV
- args' <- mapM (instantiateTyVarsToUnknown cms) args
- return$ mkTyConApp tycon args'
--- we have a tyvar of kind *
- | Just tyvar <- getTyVar_maybe ty
- , ([],_) <- splitKindFunTys (tyVarKind tyvar)
- = unknownTV
--- we have a higher kind tyvar, so insert an unknown of the appropriate kind
- | Just tyvar <- getTyVar_maybe ty
- , (args,_) <- splitKindFunTys (tyVarKind tyvar)
- = liftM mkTyConTy $ unknownTC !! length args
--- Base case
- | otherwise = return ty
-
- where unknownTV = do
- Just (ATyCon unknown_tc) <- lookupName cms unknownTyConName
- return$ mkTyConTy unknown_tc
- unknownTC = [undefined, unknownTC1, unknownTC2, unknownTC3]
- unknownTC1 = do
- Just (ATyCon unknown_tc) <- lookupName cms unknown1TyConName
- return unknown_tc
- unknownTC2 = do
- Just (ATyCon unknown_tc) <- lookupName cms unknown2TyConName
- return unknown_tc
- unknownTC3 = do
- Just (ATyCon unknown_tc) <- lookupName cms unknown3TyConName
- return unknown_tc
--- isGADT ty | pprTrace' "isGADT" (ppr ty <> colon <> ppr(isGadtSyntaxTyCon ty)) False = undefined
- isGADT tc | Just dcs <- tyConDataCons_maybe tc = any (not . null . dataConEqSpec) dcs
- | otherwise = False
- fixTyVars ty
- | Just (tycon, args) <- splitTyConApp_maybe ty
- = mapM fixTyVars args >>= return . mkTyConApp tycon
--- Fix the tyvar so that the interactive environment doesn't choke on it TODO
- | Just tv <- getTyVar_maybe ty = return ty --TODO
- | otherwise = return ty
-
-- | The inverse function. Strip the GHC.Base.Unknowns in the type of the id, they correspond to tyvars. The caller must provide an infinite list of fresh names
stripUnknowns :: [Name] -> Id -> Id
stripUnknowns names id = setIdType id . fst . go names . idType
@@ -289,3 +243,8 @@ stripUnknowns names id = setIdType id . fst . go names . idType
kind1 = mkArrowKind liftedTypeKind liftedTypeKind
kind2 = mkArrowKind kind1 liftedTypeKind
kind3 = mkArrowKind kind2 liftedTypeKind
+
+instantiateTyVarsToUnknown :: Session -> Type -> IO Type
+instantiateTyVarsToUnknown (Session ref) ty
+ = do hsc_env <- readIORef ref
+ DebuggerTys.instantiateTyVarsToUnknown hsc_env ty