X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnExpr.lhs;h=e9685908126cb86cd7bc3b015c3a911717eeaca3;hp=716a85a3b3ad4ad094c8ecc0b11d58211e9b99bb;hb=5edf58c10a0144fa8b328e18d0b7fffec2319424;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 716a85a..e968590 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -34,7 +34,8 @@ import PrelNames	( thFAKE, hasKey, assertIdKey, assertErrorName,
 			  loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
 			  negateName, thenMName, bindMName, failMName )
 #if defined(GHCI) && defined(BREAKPOINT)
-import PrelNames        ( breakpointJumpName, undefined_RDR, breakpointIdKey )
+import PrelNames        ( breakpointJumpName, breakpointCondJumpName
+                        , undefined_RDR, breakpointIdKey, breakpointCondIdKey )
 import UniqFM           ( eltsUFM )
 import DynFlags         ( GhcMode(..) )
 import SrcLoc           ( srcSpanFile, srcSpanStartLine )
@@ -43,7 +44,7 @@ import Name             ( isTyVarName )
 import Name		( Name, nameOccName, nameIsLocalOrFrom )
 import NameSet
 import RdrName		( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv )
-import LoadIface	( loadHomeInterface )
+import LoadIface	( loadInterfaceForName )
 import UniqFM		( isNullUFM )
 import UniqSet		( emptyUniqSet )
 import List		( nub )
@@ -99,20 +100,25 @@ rnExpr (HsVar v)
        lclEnv         <- getLclEnv
        ignore_asserts <- doptM Opt_IgnoreAsserts
        ignore_breakpoints <- doptM Opt_IgnoreBreakpoints
+       ghcMode        <- getGhcMode
        let conds = [ (name `hasKey` assertIdKey
                       && not ignore_asserts,
                       do (e, fvs) <- mkAssertErrorExpr
                          return (e, fvs `addOneFV` name))
 #if defined(GHCI) && defined(BREAKPOINT)
                    , (name `hasKey` breakpointIdKey
-                      && not ignore_breakpoints,
-                      do ghcMode <- getGhcMode
-                         case ghcMode of
-                           Interactive
-                               -> do let isWantedName = not.isTyVarName
-                                     (e, fvs) <- mkBreakPointExpr (filter isWantedName (eltsUFM localRdrEnv))
-                                     return (e, fvs `addOneFV` name)
-                           _ -> return (HsVar name, unitFV name)
+                      && not ignore_breakpoints
+                      && ghcMode == Interactive,
+                         do let isWantedName = not.isTyVarName
+                            (e, fvs) <- mkBreakpointExpr (filter isWantedName (eltsUFM localRdrEnv))
+                            return (e, fvs `addOneFV` name)
+                     )
+                   , (name `hasKey` breakpointCondIdKey
+                      && not ignore_breakpoints
+                      && ghcMode == Interactive,
+                         do let isWantedName = not.isTyVarName
+                            (e, fvs) <- mkBreakpointCondExpr (filter isWantedName (eltsUFM localRdrEnv))
+                            return (e, fvs `addOneFV` name)
                      )
 #endif
                    ]
@@ -544,7 +550,7 @@ rnRbinds str rbinds
 rnBracket (VarBr n) = do { name <- lookupOccRn n
 			 ; this_mod <- getModule
 			 ; checkM (nameIsLocalOrFrom this_mod name) $	-- Reason: deprecation checking asumes the
-			   do { loadHomeInterface msg name		-- home interface is loaded, and this is the
+			   do { loadInterfaceForName msg name		-- home interface is loaded, and this is the
 			      ; return () }				-- only way that is going to happen
 			 ; returnM (VarBr name, unitFV name) }
 		    where
@@ -941,8 +947,14 @@ segsToStmts ((defs, uses, fwds, ss) : segs) fvs_later
 
 \begin{code}
 #if defined(GHCI) && defined(BREAKPOINT)
-mkBreakPointExpr :: [Name] -> RnM (HsExpr Name, FreeVars)
-mkBreakPointExpr scope
+mkBreakpointExpr :: [Name] -> RnM (HsExpr Name, FreeVars)
+mkBreakpointExpr = mkBreakpointExpr' breakpointJumpName
+
+mkBreakpointCondExpr :: [Name] -> RnM (HsExpr Name, FreeVars)
+mkBreakpointCondExpr = mkBreakpointExpr' breakpointCondJumpName
+
+mkBreakpointExpr' :: Name -> [Name] -> RnM (HsExpr Name, FreeVars)
+mkBreakpointExpr' breakpointFunc scope
     = do sloc <- getSrcSpanM
          undef <- lookupOccRn undefined_RDR
          let inLoc = L sloc
@@ -951,7 +963,7 @@ mkBreakPointExpr scope
              mkExpr' fnName [] = inLoc (HsVar fnName)
              mkExpr' fnName (arg:args)
                  = lHsApp (mkExpr' fnName args) (inLoc arg)
-             expr = unLoc $ mkExpr breakpointJumpName [mkScopeArg scope, HsVar undef, HsLit msg]
+             expr = unLoc $ mkExpr breakpointFunc [mkScopeArg scope, HsVar undef, HsLit msg]
              mkScopeArg args
                  = unLoc $ mkExpr undef (map HsVar args)
              msg = HsString (mkFastString (unpackFS (srcSpanFile sloc) ++ ":" ++ show (srcSpanStartLine sloc)))