module SrcLoc (
SrcLoc, -- Abstract
- mkSrcLoc, isGoodSrcLoc,
+ mkSrcLoc, isGoodSrcLoc, mkGeneralSrcLoc,
noSrcLoc, -- "I'm sorry, I haven't a clue"
+ advanceSrcLoc,
importedSrcLoc, -- Unknown place in an interface
- builtinSrcLoc, -- Something wired into the compiler
+ wiredInSrcLoc, -- Something wired into the compiler
generatedSrcLoc, -- Code generated within the compiler
+ interactiveSrcLoc, -- Code from an interactive session
- incSrcLine, replaceSrcLine,
-
- srcLocFile, -- return the file name part.
- srcLocLine -- return the line part.
+ srcLocFile, -- return the file name part
+ srcLocLine, -- return the line part
+ srcLocCol, -- return the column part
) where
#include "HsVersions.h"
import Util ( thenCmp )
import Outputable
-import FastString ( unpackFS )
import FastTypes
-import GlaExts ( Int(..), (+#) )
+import FastString
+
+import GLAEXTS ( (+#), quotInt# )
\end{code}
%************************************************************************
this is the obvious stuff:
\begin{code}
data SrcLoc
- = SrcLoc FAST_STRING -- A precise location (file name)
- FastInt
+ = SrcLoc FastString -- A precise location (file name)
+ FastInt -- line
+ FastInt -- column
+
+ | ImportedLoc String -- Module name
+
+ | UnhelpfulLoc FastString -- Just a general indication
- | UnhelpfulSrcLoc FAST_STRING -- Just a general indication
+{-
+data SrcSpan
+ = WiredInSpan
- | NoSrcLoc
+ -- A precise source file span
+ | SrcSpan FastString -- file name
+ FastInt -- beginning line
+ FastInt -- beginning column
+ FastInt -- end line
+ FastInt -- end column
+
+ | UnhelpfulSrcSpan FastString -- Just a general indication
+-}
\end{code}
Note that an entity might be imported via more than one route, and
Things to make 'em:
\begin{code}
-mkSrcLoc x y = SrcLoc x (iUnbox y)
-noSrcLoc = NoSrcLoc
-importedSrcLoc = UnhelpfulSrcLoc SLIT("<imported>")
-builtinSrcLoc = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
-generatedSrcLoc = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
-
-isGoodSrcLoc (SrcLoc _ _) = True
-isGoodSrcLoc other = False
-
-srcLocFile :: SrcLoc -> FAST_STRING
-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
+mkSrcLoc x line col = SrcLoc x (iUnbox line) (iUnbox col)
+noSrcLoc = UnhelpfulLoc FSLIT("<no locn>")
+generatedSrcLoc = UnhelpfulLoc FSLIT("<compiler-generated code>")
+wiredInSrcLoc = UnhelpfulLoc FSLIT("<wired into compiler>")
+interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
+
+mkGeneralSrcLoc :: FastString -> SrcLoc
+mkGeneralSrcLoc = UnhelpfulLoc
+
+importedSrcLoc :: String -> SrcLoc
+importedSrcLoc mod_name = ImportedLoc mod_name
+
+isGoodSrcLoc (SrcLoc _ _ _) = True
+isGoodSrcLoc other = False
+
+srcLocFile :: SrcLoc -> FastString
+srcLocFile (SrcLoc fname _ _) = fname
+srcLocFile other = FSLIT("<unknown file")
+
+srcLocLine :: SrcLoc -> Int
+srcLocLine (SrcLoc _ l c) = iBox l
+srcLocLine other = panic "srcLocLine: unknown line"
+
+srcLocCol :: SrcLoc -> Int
+srcLocCol (SrcLoc _ l c) = iBox c
+srcLocCol other = panic "srcLocCol: unknown col"
+
+advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
+advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f l (tab c)
+advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f (l +# 1#) 0#
+advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c +# 1#)
+advanceSrcLoc loc _ = loc -- Better than nothing
+
+-- Advance to the next tab stop. Tabs are at column positions 0, 8, 16, etc.
+tab :: FastInt -> FastInt
+tab c = (c `quotInt#` 8# +# 1#) *# 8#
\end{code}
%************************************************************************
instance Ord SrcLoc where
compare = cmpSrcLoc
-cmpSrcLoc NoSrcLoc NoSrcLoc = EQ
-cmpSrcLoc NoSrcLoc other = LT
+cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
+cmpSrcLoc (UnhelpfulLoc _) other = LT
-cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2
-cmpSrcLoc (UnhelpfulSrcLoc s1) other = GT
+cmpSrcLoc (ImportedLoc _) (UnhelpfulLoc _) = GT
+cmpSrcLoc (ImportedLoc m1) (ImportedLoc m2) = m1 `compare` m2
+cmpSrcLoc (ImportedLoc _) other = LT
+
+cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
+ = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) `thenCmp` (c1 `cmpline` c2)
+ where
+ l1 `cmpline` l2 | l1 <# l2 = LT
+ | l1 ==# l2 = EQ
+ | otherwise = GT
+cmpSrcLoc (SrcLoc _ _ _) other = GT
-cmpSrcLoc (SrcLoc s1 l1) NoSrcLoc = 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)
+ ppr (SrcLoc src_path src_line src_col)
= getPprStyle $ \ sty ->
- if userStyle sty then
- hcat [ text src_file, char ':', int (iBox src_line) ]
- else
- if debugStyle sty then
- hcat [ ptext src_path, char ':', int (iBox src_line) ]
+ if userStyle sty || debugStyle sty then
+ hcat [ ftext src_path, char ':',
+ int (iBox src_line)
+ {- TODO: char ':', int (iBox src_col) -}
+ ]
else
hcat [text "{-# LINE ", int (iBox src_line), space,
- char '\"', ptext src_path, text " #-}"]
- where
- src_file = unpackFS src_path -- Leave the directory prefix intact,
- -- so emacs can find the file
+ char '\"', ftext src_path, text " #-}"]
- ppr (UnhelpfulSrcLoc s) = ptext s
- ppr NoSrcLoc = ptext SLIT("<No locn>")
+ ppr (ImportedLoc mod) = ptext SLIT("Imported from") <+> quotes (text mod)
+ ppr (UnhelpfulLoc s) = ftext s
\end{code}
projects / ghc-hetmet.git / blobdiff