[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 3dccd51..c3249df 100644 (file)
--- a/ghc/compiler/basicTypes/SrcLoc.lhs
+++ b/ghc/compiler/basicTypes/SrcLoc.lhs
@@ -11,15 +11,12 @@
 module SrcLoc (
        SrcLoc,                 -- Abstract
 
-       mkSrcLoc,
-       noSrcLoc, isNoSrcLoc,   -- "I'm sorry, I haven't a clue"
+       mkSrcLoc, isGoodSrcLoc, isWiredInLoc,
+       noSrcLoc,               -- "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
+       importedSrcLoc,         -- Unknown place in an interface
+       wiredInSrcLoc,          -- Something wired into the compiler
+       generatedSrcLoc,        -- Code generated within the compiler
 
        incSrcLine, replaceSrcLine,
        
@@ -32,7 +29,10 @@ module SrcLoc (
 import Util            ( thenCmp )
 import Outputable
 import FastString      ( unpackFS )
-import GlaExts         ( Int(..), (+#) )
+import FastTypes
+import FastString
+
+import GLAEXTS         ( (+#) )
 \end{code}
 
 %************************************************************************
@@ -45,12 +45,16 @@ We keep information about the {\em definition} point for each entity;
 this is the obvious stuff:
 \begin{code}
 data SrcLoc
-  = NoSrcLoc
+  = WiredInLoc         -- Used exclusively for Ids and TyCons
+                       -- that are totally wired in to the
+                       -- compiler.  That supports the 
+                       -- occasionally-useful predicate
+                       -- isWiredInName
 
-  | SrcLoc     FAST_STRING     -- A precise location (file name)
-               FAST_INT
+  | SrcLoc     FastString      -- A precise location (file name)
+               FastInt
 
-  | UnhelpfulSrcLoc FAST_STRING        -- Just a general indication
+  | UnhelpfulSrcLoc FastString -- Just a general indication
 \end{code}
 
 Note that an entity might be imported via more than one route, and
@@ -66,27 +70,29 @@ rare case.
 
 Things to make 'em:
 \begin{code}
-noSrcLoc           = NoSrcLoc
-mkSrcLoc x IBOX(y)  = SrcLoc x y
+mkSrcLoc x y      = SrcLoc x (iUnbox y)
+wiredInSrcLoc    = WiredInLoc
+noSrcLoc         = UnhelpfulSrcLoc FSLIT("<No locn>")
+importedSrcLoc   = UnhelpfulSrcLoc FSLIT("<imported>")
+generatedSrcLoc   = UnhelpfulSrcLoc FSLIT("<compiler-generated-code>")
 
-mkIfaceSrcLoc      = UnhelpfulSrcLoc SLIT("<an interface file>")
-mkBuiltinSrcLoc            = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
-mkGeneratedSrcLoc   = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
+isGoodSrcLoc (SrcLoc _ _) = True
+isGoodSrcLoc other        = False
 
-isNoSrcLoc NoSrcLoc = True
-isNoSrcLoc other    = False
+isWiredInLoc WiredInLoc = True
+isWiredInLoc other     = False
 
-srcLocFile :: SrcLoc -> FAST_STRING
+srcLocFile :: SrcLoc -> FastString
 srcLocFile (SrcLoc fname _) = fname
 
-srcLocLine :: SrcLoc -> FAST_INT
+srcLocLine :: SrcLoc -> FastInt
 srcLocLine (SrcLoc _ l) = l
 
 incSrcLine :: SrcLoc -> SrcLoc
 incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
 incSrcLine loc         = loc
 
-replaceSrcLine :: SrcLoc -> FAST_INT -> SrcLoc
+replaceSrcLine :: SrcLoc -> FastInt -> SrcLoc
 replaceSrcLine (SrcLoc s _) l = SrcLoc s l
 \end{code}
 
@@ -106,13 +112,13 @@ instance Eq SrcLoc where
 instance Ord SrcLoc where
   compare = cmpSrcLoc
 
-cmpSrcLoc NoSrcLoc NoSrcLoc = EQ
-cmpSrcLoc NoSrcLoc other    = LT
+cmpSrcLoc WiredInLoc WiredInLoc = EQ
+cmpSrcLoc WiredInLoc other      = LT
 
 cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2
 cmpSrcLoc (UnhelpfulSrcLoc s1) other               = GT
 
-cmpSrcLoc (SrcLoc s1 l1) NoSrcLoc           = 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
@@ -123,19 +129,15 @@ cmpSrcLoc (SrcLoc s1 l1) (SrcLoc s2 l2)      = (s1 `compare` s2) `thenCmp` (l1 `
 instance Outputable SrcLoc where
     ppr (SrcLoc src_path src_line)
       = getPprStyle $ \ sty ->
-        if userStyle sty then
-          hcat [ text src_file, char ':', int IBOX(src_line) ]
+        if userStyle sty || debugStyle sty then
+          hcat [ ftext src_path, char ':', int (iBox src_line) ]
        else
-       if debugStyle sty then
-          hcat [ ptext src_path, char ':', int IBOX(src_line) ]
-       else
-          hcat [text "{-# LINE ", int IBOX(src_line), space,
-                char '\"', ptext src_path, text " #-}"]
+          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 (UnhelpfulSrcLoc s) = ptext s
-
-    ppr NoSrcLoc = text "<NoSrcLoc>"
+    ppr (UnhelpfulSrcLoc s) = ftext s
+    ppr WiredInLoc         = ptext SLIT("<Wired in>")
 \end{code}