X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnExpr.lhs;h=99d0767a8e786e6f167922a2eda08f251096c933;hb=70f6cbd1695128f2685085d423c09e4cb889d91e;hp=e9685908126cb86cd7bc3b015c3a911717eeaca3;hpb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;p=ghc-hetmet.git diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index e968590..99d0767 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -30,6 +30,7 @@ import RnTypes ( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit, dupFieldErr, checkTupSize ) import DynFlags ( DynFlag(..) ) import BasicTypes ( FixityDirection(..) ) +import SrcLoc ( SrcSpan ) import PrelNames ( thFAKE, hasKey, assertIdKey, assertErrorName, loopAName, choiceAName, appAName, arrAName, composeAName, firstAName, negateName, thenMName, bindMName, failMName ) @@ -38,7 +39,6 @@ import PrelNames ( breakpointJumpName, breakpointCondJumpName , undefined_RDR, breakpointIdKey, breakpointCondIdKey ) import UniqFM ( eltsUFM ) import DynFlags ( GhcMode(..) ) -import SrcLoc ( srcSpanFile, srcSpanStartLine ) import Name ( isTyVarName ) #endif import Name ( Name, nameOccName, nameIsLocalOrFrom ) @@ -459,7 +459,7 @@ methodNamesCmd other = emptyFVs -- The type checker will complain later --------------------------------------------------- -methodNamesMatch (MatchGroup ms ty) +methodNamesMatch (MatchGroup ms _) = plusFVs (map do_one ms) where do_one (L _ (Match pats sig_ty grhss)) = methodNamesGRHSs grhss @@ -963,12 +963,17 @@ mkBreakpointExpr' breakpointFunc scope mkExpr' fnName [] = inLoc (HsVar fnName) mkExpr' fnName (arg:args) = lHsApp (mkExpr' fnName args) (inLoc arg) - 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))) + expr = unLoc $ mkExpr breakpointFunc [mkScopeArg scope, HsVar undef, msg] + mkScopeArg args = unLoc $ mkExpr undef (map HsVar args) + msg = srcSpanLit sloc return (expr, emptyFVs) #endif + +srcSpanLit :: SrcSpan -> HsExpr Name +srcSpanLit span = HsLit (HsString (mkFastString (showSDoc (ppr span)))) + +srcSpanPrimLit :: SrcSpan -> HsExpr Name +srcSpanPrimLit span = HsLit (HsStringPrim (mkFastString (showSDoc (ppr span)))) \end{code} %************************************************************************ @@ -983,8 +988,8 @@ mkAssertErrorExpr :: RnM (HsExpr Name, FreeVars) mkAssertErrorExpr = getSrcSpanM `thenM` \ sloc -> let - expr = HsApp (L sloc (HsVar assertErrorName)) (L sloc (HsLit msg)) - msg = HsStringPrim (mkFastString (showSDoc (ppr sloc))) + expr = HsApp (L sloc (HsVar assertErrorName)) + (L sloc (srcSpanPrimLit sloc)) in returnM (expr, emptyFVs) \end{code}