X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=845e1db2ad8cf0983f5f324d1d40d8e9fe702fa9;hp=c1b49e97e47d1217c27d04e4540bddf4ec845b1c;hb=17b297d97d327620ed6bfab942f8992b2446f1bf;hpb=940524aec90652b5ef81789c9a453c57c0e42cc9

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index c1b49e9..845e1db 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -3,6 +3,13 @@
 %
 
 \begin{code}
+{-# OPTIONS_GHC -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+-- for details
+
 module SrcLoc (
 	SrcLoc,			-- Abstract
 
@@ -28,6 +35,7 @@ module SrcLoc (
 	mkSrcSpan, srcLocSpan,
 	combineSrcSpans,
 	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
@@ -35,7 +43,8 @@ module SrcLoc (
         srcSpanStartLine, srcSpanEndLine, 
         srcSpanStartCol, srcSpanEndCol,
 
-	Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc
+	Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc,
+        leftmost_smallest, leftmost_largest, rightmost, spans, isSubspanOf
     ) where
 
 #include "HsVersions.h"
@@ -218,6 +227,12 @@ 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
@@ -393,3 +408,31 @@ instance Outputable e => Outputable (Located e) where
   ppr (L span e) =  ppr e
 	-- do we want to dump the span in debugSty mode?    
 \end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Manipulating SrcSpans}
+%*									*
+%************************************************************************
+
+\begin{code}
+leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
+rightmost            = flip compare
+leftmost_smallest    = compare 
+leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
+                                `thenCmp`
+                       (srcSpanEnd b `compare` srcSpanEnd a)
+
+
+spans :: SrcSpan -> (Int,Int) -> Bool
+spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
+   where loc = mkSrcLoc (srcSpanFile span) l c
+
+isSubspanOf :: SrcSpan -> SrcSpan -> Bool
+isSubspanOf src parent 
+    | optSrcSpanFileName parent /= optSrcSpanFileName src = False
+    | otherwise = srcSpanStart parent <= srcSpanStart src &&
+                  srcSpanEnd parent   >= srcSpanEnd src
+
+\end{code}
\ No newline at end of file