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

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index ea32651..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
 
@@ -36,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"
@@ -400,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