From 790cd00dc6ab044a6dd436a9aa781750e0d750a0 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 7 Jan 2007 21:12:40 +0000 Subject: [PATCH] Reorganizing my mess a bit --- compiler/deSugar/DsBreakpoint.lhs | 7 ++----- compiler/ghci/RtClosureInspect.hs | 14 ++++++-------- 2 files changed, 8 insertions(+), 13 deletions(-) diff --git a/compiler/deSugar/DsBreakpoint.lhs b/compiler/deSugar/DsBreakpoint.lhs index eac7e48..a0886cb 100644 --- a/compiler/deSugar/DsBreakpoint.lhs +++ b/compiler/deSugar/DsBreakpoint.lhs @@ -114,9 +114,6 @@ debug_enabled = do debug_enabled = return False #endif -maybeInsertBreakpoint :: LHsExpr Id -> Type -> DsM (LHsExpr Id) ---maybeInsertBreakpoint e | pprTrace("insertBreakpoint at" (ppr e) False = undefined - isInstrumentationSpot (L loc e) = do ghcmode <- getGhcModeDs instrumenting <- debug_enabled @@ -144,7 +141,6 @@ dynBreakpoint loc = do -- Records a breakpoint site and returns the site number recordBkpt :: SrcLoc -> DsM (Int) ---recordBkpt | trace "recordBkpt" False = undefined recordBkpt loc = do sites_var <- getBkptSitesDs sites <- ioToIOEnv$ readIORef sites_var @@ -180,13 +176,14 @@ mkJumpFunc bkptFuncId breakpoints_enabled :: DsM Bool dsAndThenMaybeInsertBreakpoint :: LHsExpr Id -> DsM CoreExpr +-- | Takes an expression and its type +maybeInsertBreakpoint :: LHsExpr Id -> Type -> DsM (LHsExpr Id) #ifdef GHCI maybeInsertBreakpoint lhsexpr@(L loc _) ty = do instrumenting <- isInstrumentationSpot lhsexpr if instrumenting then do L _ dynBkpt <- dynBreakpoint loc --- return (l (HsApp (l$ TyApp dynBkpt [ty]) lhsexpr)) return$ l(HsApp (l$ HsWrap (WpTyApp ty) dynBkpt) lhsexpr) else return lhsexpr where l = L loc diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index bfb3936..170dec0 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -61,7 +61,6 @@ import Name import VarEnv import OccName import VarSet -import Unique import {-#SOURCE#-} TcRnDriver ( tcRnRecoverDataCon ) import TysPrim @@ -125,6 +124,11 @@ isPrim _ = False termType t@(Suspension {}) = mb_ty t termType t = Just$ ty t +isFullyEvaluatedTerm :: Term -> Bool +isFullyEvaluatedTerm Term {subTerms=tt} = all isFullyEvaluatedTerm tt +isFullyEvaluatedTerm Suspension {} = False +isFullyEvaluatedTerm Prim {} = True + instance Outputable (Term) where ppr = head . customPrintTerm customPrintTermBase @@ -358,7 +362,7 @@ customPrintTermBase showP = , largeIntegerDataConName] isTupleDC Term{dc=dc} = dc `elem` snd (unzip (elems boxedTupleArr)) isDC a_dc Term{dc=dc} = a_dc == dc - coerceShow f Term{val=val} = return . text . show . f . unsafeCoerce# $ val + coerceShow f = return . text . show . f . unsafeCoerce# . val --TODO pprinting of list terms is not lazy doList h t = do let elems = h : getListTerms t @@ -379,12 +383,6 @@ customPrintTermBase showP = getListTerms t@Suspension{} = [t] getListTerms t = pprPanic "getListTerms" (ppr t) -isFullyEvaluatedTerm :: Term -> Bool -isFullyEvaluatedTerm Term {subTerms=tt} = all isFullyEvaluatedTerm tt -isFullyEvaluatedTerm Suspension {} = False -isFullyEvaluatedTerm Prim {} = True - - ----------------------------------- -- Type Reconstruction ----------------------------------- -- 1.7.10.4