X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnExpr.lhs;h=1c80bc0101bb4c28af993991731ced3f96ece765;hb=3a99fa889bdff0c86df20cb18c71d30e30a79b43;hp=211ed58be67cbf00288cfafd9884809f5edbf73d;hpb=5ad61e1470db6dbc8279569c5ad1cc093f753ac0;p=ghc-hetmet.git diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 211ed58..1c80bc0 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -35,13 +35,7 @@ import SrcLoc ( SrcSpan ) import PrelNames ( thFAKE, hasKey, assertIdKey, assertErrorName, loopAName, choiceAName, appAName, arrAName, composeAName, firstAName, negateName, thenMName, bindMName, failMName ) -#if defined(GHCI) && defined(BREAKPOINT) -import PrelNames ( breakpointJumpName, breakpointCondJumpName - , undefined_RDR, breakpointIdKey, breakpointCondIdKey ) -import UniqFM ( eltsUFM ) -import DynFlags ( GhcMode(..) ) -import Name ( isTyVarName ) -#endif + import Name ( Name, nameOccName, nameIsLocalOrFrom ) import NameSet import RdrName ( RdrName, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals ) @@ -106,22 +100,6 @@ rnExpr (HsVar v) && not ignore_asserts, do (e, fvs) <- mkAssertErrorExpr return (e, fvs `addOneFV` name)) -#if defined(GHCI) && defined(BREAKPOINT) - , (name `hasKey` breakpointIdKey - && 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 ] case lookup True conds of Just action -> action @@ -945,48 +923,14 @@ segsToStmts ((defs, uses, fwds, ss) : segs) fvs_later %************************************************************************ %* * -\subsubsection{breakpoint utils} +\subsubsection{Assertion utils} %* * %************************************************************************ \begin{code} -#if defined(GHCI) && defined(BREAKPOINT) -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 - lHsApp x y = inLoc (HsApp x y) - mkExpr fnName args = mkExpr' fnName (reverse args) - mkExpr' fnName [] = inLoc (HsVar fnName) - mkExpr' fnName (arg:args) - = lHsApp (mkExpr' fnName args) (inLoc arg) - expr = unLoc $ mkExpr breakpointFunc [mkScopeArg scope, HsVar undef, msg] - mkScopeArg args = unLoc $ mkExpr undef (map HsVar args) - msg = srcSpanLit sloc - return (expr, emptyFVs) - -srcSpanLit :: SrcSpan -> HsExpr Name -srcSpanLit span = HsLit (HsString (mkFastString (showSDoc (ppr span)))) -#endif - srcSpanPrimLit :: SrcSpan -> HsExpr Name srcSpanPrimLit span = HsLit (HsStringPrim (mkFastString (showSDoc (ppr span)))) -\end{code} -%************************************************************************ -%* * -\subsubsection{Assertion utils} -%* * -%************************************************************************ - -\begin{code} mkAssertErrorExpr :: RnM (HsExpr Name, FreeVars) -- Return an expression for (assertError "Foo.hs:27") mkAssertErrorExpr @@ -1015,3 +959,5 @@ badIpBinds what binds = hang (ptext SLIT("Implicit-parameter bindings illegal in") <+> what) 2 (ppr binds) \end{code} + +