pprDefnLoc,
SrcSpan, -- Abstract
- noSrcSpan,
+ noSrcSpan,
mkGeneralSrcSpan,
- isGoodSrcSpan,
+ isGoodSrcSpan, isOneLineSpan,
mkSrcSpan, srcLocSpan,
combineSrcSpans,
- srcSpanFile,
- srcSpanStartLine, srcSpanEndLine,
- srcSpanStartCol, srcSpanEndCol,
srcSpanStart, srcSpanEnd,
+ -- These are dubious exports, because they crash on some inputs,
+ -- used only in Lexer.x where we are sure what the Span looks like
+ srcSpanFile, srcSpanEndLine, srcSpanEndCol,
+
Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc
) where
isGoodSrcSpan SrcSpanPoint{} = True
isGoodSrcSpan _ = False
+isOneLineSpan :: SrcSpan -> Bool
+-- True if the span is known to straddle more than one line
+-- By default, it returns False
+isOneLineSpan s
+ | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s
+ | otherwise = False
+
+--------------------------------------------------------
+-- Don't export these four;
+-- they panic on Imported, Unhelpful.
+-- They are for internal use only
+-- Urk! Some are needed for Lexer.x; see comment in export list
+
srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
+--------------------------------------------------------
srcSpanStart (ImportedSpan str) = ImportedLoc str
srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
-srcSpanStart s =
- mkSrcLoc (srcSpanFile s)
- (srcSpanStartLine s)
- (srcSpanStartCol s)
+srcSpanStart s = mkSrcLoc (srcSpanFile s)
+ (srcSpanStartLine s)
+ (srcSpanStartCol s)
srcSpanEnd (ImportedSpan str) = ImportedLoc str
srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
import UniqSupply
import BasicTypes ( IPName, mapIPName )
import SrcLoc ( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc,
- srcLocSpan, getLoc, combineSrcSpans, srcSpanStartLine, srcSpanEndLine )
+ srcLocSpan, getLoc, combineSrcSpans, isOneLineSpan )
import Outputable
import Util ( sortLe )
import ListSetOps ( removeDups )
L _ name1 = head located_names
locs = map getLoc located_names
big_loc = foldr1 combineSrcSpans locs
- one_line = srcSpanStartLine big_loc == srcSpanEndLine big_loc
+ one_line = isOneLineSpan big_loc
locations | one_line = empty
| otherwise = ptext SLIT("Bound at:") <+>
vcat (map ppr (sortLe (<=) locs))
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 )
, undefined_RDR, breakpointIdKey, breakpointCondIdKey )
import UniqFM ( eltsUFM )
import DynFlags ( GhcMode(..) )
-import SrcLoc ( srcSpanFile, srcSpanStartLine )
import Name ( isTyVarName )
#endif
import Name ( Name, nameOccName, nameIsLocalOrFrom )
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))))
\end{code}
%************************************************************************
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 (srcSpanLit sloc))
in
returnM (expr, emptyFVs)
\end{code}