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

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index 51d4318..ea32651 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 (
@@ -16,7 +11,6 @@ module SrcLoc (
 	advanceSrcLoc,
 
 	importedSrcLoc,		-- Unknown place in an interface
-	wiredInSrcLoc,		-- Something wired into the compiler
 	generatedSrcLoc,	-- Code generated within the compiler
 	interactiveSrcLoc,	-- Code from an interactive session
 
@@ -26,22 +20,28 @@ module SrcLoc (
 	pprDefnLoc,
 
 	SrcSpan,		-- Abstract
-	noSrcSpan,
+	noSrcSpan, 
+	wiredInSrcSpan,		-- Something wired into the compiler
+	importedSrcSpan,	-- Unknown place in an interface
 	mkGeneralSrcSpan, 
-	isGoodSrcSpan,
+	isGoodSrcSpan, isOneLineSpan,
 	mkSrcSpan, srcLocSpan,
 	combineSrcSpans,
-	srcSpanFile,
-	srcSpanStartLine, srcSpanEndLine,
-	srcSpanStartCol, srcSpanEndCol,
 	srcSpanStart, srcSpanEnd,
+	optSrcSpanFileName,
+
+	-- 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}
@@ -62,7 +62,7 @@ data SrcLoc
 		-- Don't ask me why lines start at 1 and columns start at
 		-- zero.  That's just the way it is, so there.  --SDM
 
-  | ImportedLoc	String		-- Module name
+  | ImportedLoc	FastString	-- Module name
 
   | UnhelpfulLoc FastString	-- Just a general indication
 \end{code}
@@ -83,13 +83,12 @@ Things to make 'em:
 mkSrcLoc x line col = SrcLoc x line col
 noSrcLoc	  = UnhelpfulLoc FSLIT("<no location info>")
 generatedSrcLoc   = UnhelpfulLoc FSLIT("<compiler-generated code>")
-wiredInSrcLoc     = UnhelpfulLoc FSLIT("<wired into compiler>")
 interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
 
 mkGeneralSrcLoc :: FastString -> SrcLoc
 mkGeneralSrcLoc = UnhelpfulLoc 
 
-importedSrcLoc :: String -> SrcLoc
+importedSrcLoc :: FastString -> SrcLoc
 importedSrcLoc mod_name = ImportedLoc mod_name
 
 isGoodSrcLoc (SrcLoc _ _ _) = True
@@ -137,11 +136,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 +151,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") <+> ftext mod
     ppr (UnhelpfulLoc s)  = ftext s
 \end{code}
 
@@ -199,7 +194,7 @@ data SrcSpan
 	  srcSpanCol      :: !Int
 	}
 
-  | ImportedSpan String		-- Module name
+  | ImportedSpan FastString	-- Module name
 
   | UnhelpfulSpan FastString	-- Just a general indication
 				-- also used to indicate an empty span
@@ -212,7 +207,9 @@ instance Ord SrcSpan where
      (srcSpanStart a `compare` srcSpanStart b) `thenCmp` 
      (srcSpanEnd   a `compare` srcSpanEnd   b)
 
-noSrcSpan  = UnhelpfulSpan FSLIT("<no location info>")
+noSrcSpan      = UnhelpfulSpan FSLIT("<no location info>")
+wiredInSrcSpan = UnhelpfulSpan FSLIT("<wired into compiler>")
+importedSrcSpan = ImportedSpan
 
 mkGeneralSrcSpan :: FastString -> SrcSpan
 mkGeneralSrcSpan = UnhelpfulSpan
@@ -222,6 +219,25 @@ isGoodSrcSpan SrcSpanMultiLine{} = True
 isGoodSrcSpan SrcSpanPoint{} = True
 isGoodSrcSpan _ = False
 
+optSrcSpanFileName :: SrcSpan -> Maybe FastString
+optSrcSpanFileName (SrcSpanOneLine { srcSpanFile = nm })   = Just nm
+optSrcSpanFileName (SrcSpanMultiLine { srcSpanFile = nm }) = Just nm
+optSrcSpanFileName (SrcSpanPoint { srcSpanFile = nm})      = Just nm
+optSrcSpanFileName _                                       = Nothing
+
+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 +257,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
@@ -299,11 +315,11 @@ combineSrcSpans	start end
 	col2  = srcSpanEndCol end
 	file  = srcSpanFile start
 
-pprDefnLoc :: SrcLoc -> SDoc
+pprDefnLoc :: SrcSpan -> SDoc
 -- "defined at ..." or "imported from ..."
 pprDefnLoc loc
-  | isGoodSrcLoc loc = ptext SLIT("Defined at") <+> ppr loc
-  | otherwise	     = ppr loc
+  | isGoodSrcSpan loc = ptext SLIT("Defined at") <+> ppr loc
+  | otherwise	      = ppr loc
 
 instance Outputable SrcSpan where
     ppr span
@@ -340,7 +356,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") <+> ftext mod
 pprUserSpan (UnhelpfulSpan s)  = ftext s
 \end{code}