[project @ 2002-09-13 15:02:25 by simonpj]

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

diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs
index 03fb6c2..c3249df 100644 (file)
--- a/ghc/compiler/basicTypes/SrcLoc.lhs
+++ b/ghc/compiler/basicTypes/SrcLoc.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 %************************************************************************
 %*                                                                     *
@@ -8,24 +8,31 @@
 %************************************************************************
 
 \begin{code}
-#include "HsVersions.h"
-
 module SrcLoc (
-       SrcLoc,                 -- abstract
-
-       mkSrcLoc, mkSrcLoc2,    -- the usual
-       mkUnknownSrcLoc,        -- "I'm sorry, I haven't a clue"
-       mkIfaceSrcLoc,          -- Unknown place in an interface
-                               -- (this one can die eventually ToDo)
-       mkBuiltinSrcLoc,        -- something wired into the compiler
-       mkGeneratedSrcLoc,      -- code generated within the compiler
-       unpackSrcLoc
+       SrcLoc,                 -- Abstract
+
+       mkSrcLoc, isGoodSrcLoc, isWiredInLoc,
+       noSrcLoc,               -- "I'm sorry, I haven't a clue"
+
+       importedSrcLoc,         -- Unknown place in an interface
+       wiredInSrcLoc,          -- Something wired into the compiler
+       generatedSrcLoc,        -- Code generated within the compiler
+
+       incSrcLine, replaceSrcLine,
+       
+       srcLocFile,             -- return the file name part.
+       srcLocLine              -- return the line part.
     ) where
 
-IMP_Ubiq()
+#include "HsVersions.h"
+
+import Util            ( thenCmp )
+import Outputable
+import FastString      ( unpackFS )
+import FastTypes
+import FastString
 
-import PprStyle                ( PprStyle(..) )
-import Pretty
+import GLAEXTS         ( (+#) )
 \end{code}
 
 %************************************************************************
@@ -38,10 +45,16 @@ We keep information about the {\em definition} point for each entity;
 this is the obvious stuff:
 \begin{code}
 data SrcLoc
-  = SrcLoc     FAST_STRING     -- source file name
-               FAST_STRING     -- line number in source file
-  | SrcLoc2    FAST_STRING     -- same, but w/ an Int line#
-               FAST_INT
+  = WiredInLoc         -- Used exclusively for Ids and TyCons
+                       -- that are totally wired in to the
+                       -- compiler.  That supports the 
+                       -- occasionally-useful predicate
+                       -- isWiredInName
+
+  | SrcLoc     FastString      -- A precise location (file name)
+               FastInt
+
+  | UnhelpfulSrcLoc FastString -- Just a general indication
 \end{code}
 
 Note that an entity might be imported via more than one route, and
@@ -57,15 +70,30 @@ rare case.
 
 Things to make 'em:
 \begin{code}
-mkSrcLoc           = SrcLoc
-mkSrcLoc2 x IBOX(y) = SrcLoc2 x y
-mkUnknownSrcLoc            = SrcLoc SLIT("<unknown>") SLIT("<unknown>")
-mkIfaceSrcLoc      = SrcLoc SLIT("<an interface file>") SLIT("<unknown>")
-mkBuiltinSrcLoc            = SrcLoc SLIT("<built-into-the-compiler>") SLIT("<none>")
-mkGeneratedSrcLoc   = SrcLoc SLIT("<compiler-generated-code>") SLIT("<none>")
-
-unpackSrcLoc (SrcLoc  src_file src_line) = (src_file, src_line)
-unpackSrcLoc (SrcLoc2 src_file src_line) = (src_file, _PK_ (show IBOX(src_line)))
+mkSrcLoc x y      = SrcLoc x (iUnbox y)
+wiredInSrcLoc    = WiredInLoc
+noSrcLoc         = UnhelpfulSrcLoc FSLIT("<No locn>")
+importedSrcLoc   = UnhelpfulSrcLoc FSLIT("<imported>")
+generatedSrcLoc   = UnhelpfulSrcLoc FSLIT("<compiler-generated-code>")
+
+isGoodSrcLoc (SrcLoc _ _) = True
+isGoodSrcLoc other        = False
+
+isWiredInLoc WiredInLoc = True
+isWiredInLoc other     = False
+
+srcLocFile :: SrcLoc -> FastString
+srcLocFile (SrcLoc fname _) = fname
+
+srcLocLine :: SrcLoc -> FastInt
+srcLocLine (SrcLoc _ l) = l
+
+incSrcLine :: SrcLoc -> SrcLoc
+incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
+incSrcLine loc         = loc
+
+replaceSrcLine :: SrcLoc -> FastInt -> SrcLoc
+replaceSrcLine (SrcLoc s _) l = SrcLoc s l
 \end{code}
 
 %************************************************************************
@@ -75,14 +103,41 @@ unpackSrcLoc (SrcLoc2 src_file src_line) = (src_file, _PK_ (show IBOX(src_line))
 %************************************************************************
 
 \begin{code}
-instance Outputable SrcLoc where
-    ppr PprForUser (SrcLoc src_file src_line)
-      = ppBesides [ ppChar '"', ppPStr src_file, ppPStr SLIT("\", line "), ppPStr src_line ]
+-- SrcLoc is an instance of Ord so that we can sort error messages easily
+instance Eq SrcLoc where
+  loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
+                  EQ    -> True
+                  other -> False
+
+instance Ord SrcLoc where
+  compare = cmpSrcLoc
+
+cmpSrcLoc WiredInLoc WiredInLoc = EQ
+cmpSrcLoc WiredInLoc other      = LT
 
-    ppr sty (SrcLoc src_file src_line)
-      = ppBesides [ppPStr SLIT("{-# LINE "), ppPStr src_line, ppSP,
-                  ppChar '"', ppPStr src_file, ppPStr SLIT("\" #-}")]
+cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2
+cmpSrcLoc (UnhelpfulSrcLoc s1) other               = GT
+
+cmpSrcLoc (SrcLoc s1 l1) WiredInLoc         = GT
+cmpSrcLoc (SrcLoc s1 l1) (UnhelpfulSrcLoc _) = LT
+cmpSrcLoc (SrcLoc s1 l1) (SrcLoc s2 l2)      = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2)
+                                            where
+                                               l1 `cmpline` l2 | l1 <#  l2 = LT
+                                                               | l1 ==# l2 = EQ
+                                                               | otherwise = GT 
+                                         
+instance Outputable SrcLoc where
+    ppr (SrcLoc src_path src_line)
+      = getPprStyle $ \ sty ->
+        if userStyle sty || debugStyle sty then
+          hcat [ ftext src_path, char ':', int (iBox src_line) ]
+       else
+          hcat [text "{-# LINE ", int (iBox src_line), space,
+                char '\"', ftext src_path, text " #-}"]
+      where
+       src_file = unpackFS src_path    -- Leave the directory prefix intact,
+                                       -- so emacs can find the file
 
-    ppr sty (SrcLoc2 src_file src_line)
-      = ppr sty (SrcLoc src_file (_PK_ (show IBOX(src_line))))
+    ppr (UnhelpfulSrcLoc s) = ftext s
+    ppr WiredInLoc         = ptext SLIT("<Wired in>")
 \end{code}