Add {-# OPTIONS_GHC -w #-} and some blurb to all compiler modules

[ghc-hetmet.git] / compiler / basicTypes / SrcLoc.lhs

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index c1b49e9..845e1db 100644 (file)
--- 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