Remove CPP from nativeGen/RegAlloc/Graph/TrivColorable.hs

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

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index 8bed6c1..d2cbd7f 100644 (file)
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -165,11 +165,11 @@ instance Ord SrcLoc where
    
 cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering
 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
-cmpSrcLoc (UnhelpfulLoc _)  _other            = LT
+cmpSrcLoc (UnhelpfulLoc _)  (SrcLoc _ _ _)    = GT
+cmpSrcLoc (SrcLoc _ _ _)    (UnhelpfulLoc _)  = LT
 
 cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)      
   = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
-cmpSrcLoc (SrcLoc _ _ _) _other = GT
 
 instance Outputable SrcLoc where
     ppr (SrcLoc src_path src_line src_col)
@@ -185,8 +185,6 @@ instance Outputable SrcLoc where
 
     ppr (UnhelpfulLoc s)  = ftext s
 
-INSTANCE_TYPEABLE0(SrcSpan,srcSpanTc,"SrcSpan")
-
 instance Data SrcSpan where
   -- don't traverse?
   toConstr _   = abstractConstr "SrcSpan"
@@ -237,10 +235,10 @@ data SrcSpan
                                -- also used to indicate an empty span
 
 #ifdef DEBUG
-  deriving (Eq, Show)  -- Show is used by Lexer.x, becuase we
-                       -- derive Show for Token
+  deriving (Eq, Typeable, Show) -- Show is used by Lexer.x, becuase we
+                                -- derive Show for Token
 #else
-  deriving Eq
+  deriving (Eq, Typeable)
 #endif
 
 -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
@@ -278,20 +276,18 @@ mkSrcSpan loc1 loc2
 combineSrcSpans        :: SrcSpan -> SrcSpan -> SrcSpan
 combineSrcSpans        (UnhelpfulSpan _) r = r -- this seems more useful
 combineSrcSpans        l (UnhelpfulSpan _) = l
-combineSrcSpans        start end 
- = case line1 `compare` line2 of
-     EQ -> case col1 `compare` col2 of
-               EQ -> SrcSpanPoint file line1 col1
-               LT -> SrcSpanOneLine file line1 col1 col2
-               GT -> SrcSpanOneLine file line1 col2 col1
-     LT -> SrcSpanMultiLine file line1 col1 line2 col2
-     GT -> SrcSpanMultiLine file line2 col2 line1 col1
+combineSrcSpans        span1 span2
+ = if line_start == line_end 
+   then if col_start == col_end
+        then SrcSpanPoint     file line_start col_start
+        else SrcSpanOneLine   file line_start col_start col_end
+   else      SrcSpanMultiLine file line_start col_start line_end col_end
   where
-       line1 = srcSpanStartLine start
-       col1  = srcSpanStartCol start
-       line2 = srcSpanEndLine end
-       col2  = srcSpanEndCol end
-       file  = srcSpanFile start
+    (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)
+                                 (srcSpanStartLine span2, srcSpanStartCol span2)
+    (line_end, col_end)     = max (srcSpanEndLine span1, srcSpanEndCol span1)
+                                 (srcSpanEndLine span2, srcSpanEndCol span2)
+    file = srcSpanFile span1
 \end{code}
 
 %************************************************************************
@@ -454,7 +450,7 @@ pprDefnLoc loc
 \begin{code}
 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
 data Located e = L SrcSpan e
-  deriving (Typeable, Data)
+  deriving (Eq, Ord, Typeable, Data)
 
 unLoc :: Located e -> e
 unLoc (L _ e) = e
@@ -491,7 +487,7 @@ instance Functor Located where
   fmap f (L l e) = L l (f e)
 
 instance Outputable e => Outputable (Located e) where
-  ppr (L l e) = ifPprDebug (braces (pprUserSpan False l)) <> ppr e
+  ppr (L l e) = ifPprDebug (braces (pprUserSpan False l)) $$ ppr e
                -- Print spans without the file name etc
 \end{code}