X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=e028c1267696554047816469e012be63b6bdcad3;hb=55710e16202e985f8e4f910a09dfc2d0298ca255;hp=51d4318b0be60e8c785d8a28b959b04e4c7a62f3;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index 51d4318..e028c12 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -1,11 +1,6 @@
 %
-% (c) The University of Glasgow, 1992-2003
+% (c) The University of Glasgow, 1992-2006
 %
-%************************************************************************
-%*									*
-\section[SrcLoc]{The @SrcLoc@ type}
-%*									*
-%************************************************************************
 
 \begin{code}
 module SrcLoc (
@@ -26,22 +21,25 @@ module SrcLoc (
 	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, 
+        srcSpanStartLine, srcSpanEndLine, 
+        srcSpanStartCol, srcSpanEndCol,
+
 	Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc
     ) where
 
 #include "HsVersions.h"
 
-import Util		( thenCmp )
+import Util
 import Outputable
 import FastString
 \end{code}
@@ -137,11 +135,7 @@ cmpSrcLoc (ImportedLoc m1) (ImportedLoc m2)  = m1 `compare` m2
 cmpSrcLoc (ImportedLoc _)  other	     = LT
 
 cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)      
-  = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) `thenCmp` (c1 `cmpline` c2)
-  where
-	l1 `cmpline` l2 | l1 <  l2 = LT
-			| l1 == l2 = EQ
-			| otherwise = GT 
+  = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
 cmpSrcLoc (SrcLoc _ _ _) other = GT
 
 instance Outputable SrcLoc where
@@ -156,7 +150,7 @@ instance Outputable SrcLoc where
 	   hcat [text "{-# LINE ", int src_line, space,
 		 char '\"', ftext src_path, text " #-}"]
 
-    ppr (ImportedLoc mod) = ptext SLIT("Imported from") <+> text mod
+    ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> text mod
     ppr (UnhelpfulLoc s)  = ftext s
 \end{code}
 
@@ -222,6 +216,19 @@ isGoodSrcSpan SrcSpanMultiLine{} = True
 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
@@ -241,13 +248,13 @@ srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
 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
@@ -340,7 +347,7 @@ pprUserSpan (SrcSpanPoint src_path line col)
 	   char ':', int col
 	 ]
 
-pprUserSpan (ImportedSpan mod) = ptext SLIT("Imported from") <+> quotes (text mod)
+pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> text mod
 pprUserSpan (UnhelpfulSpan s)  = ftext s
 \end{code}