2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %************************************************************************
6 \section[SrcLoc]{The @SrcLoc@ type}
8 %************************************************************************
15 noSrcLoc, isNoSrcLoc, -- "I'm sorry, I haven't a clue"
17 mkIfaceSrcLoc, -- Unknown place in an interface
18 -- (this one can die eventually ToDo)
20 mkBuiltinSrcLoc, -- Something wired into the compiler
22 mkGeneratedSrcLoc, -- Code generated within the compiler
26 srcLocFile -- return the file name part.
29 #include "HsVersions.h"
31 import Util ( thenCmp )
33 import FastString ( unpackFS )
34 import GlaExts ( Int(..), (+#) )
37 %************************************************************************
39 \subsection[SrcLoc-SrcLocations]{Source-location information}
41 %************************************************************************
43 We keep information about the {\em definition} point for each entity;
44 this is the obvious stuff:
49 | SrcLoc FAST_STRING -- A precise location (file name)
52 | UnhelpfulSrcLoc FAST_STRING -- Just a general indication
55 Note that an entity might be imported via more than one route, and
56 there could be more than one ``definition point'' --- in two or more
57 \tr{.hi} files. We deemed it probably-unworthwhile to cater for this
60 %************************************************************************
62 \subsection[SrcLoc-access-fns]{Access functions for names}
64 %************************************************************************
69 mkSrcLoc x IBOX(y) = SrcLoc x y
71 mkIfaceSrcLoc = UnhelpfulSrcLoc SLIT("<an interface file>")
72 mkBuiltinSrcLoc = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
73 mkGeneratedSrcLoc = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
75 isNoSrcLoc NoSrcLoc = True
76 isNoSrcLoc other = False
78 srcLocFile :: SrcLoc -> FAST_STRING
79 srcLocFile (SrcLoc fname _) = fname
81 incSrcLine :: SrcLoc -> SrcLoc
82 incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
86 %************************************************************************
88 \subsection[SrcLoc-instances]{Instance declarations for various names}
90 %************************************************************************
93 -- SrcLoc is an instance of Ord so that we can sort error messages easily
94 instance Eq SrcLoc where
95 loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
99 instance Ord SrcLoc where
102 cmpSrcLoc NoSrcLoc NoSrcLoc = EQ
103 cmpSrcLoc NoSrcLoc other = LT
105 cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2
106 cmpSrcLoc (UnhelpfulSrcLoc s1) other = GT
108 cmpSrcLoc (SrcLoc s1 l1) NoSrcLoc = GT
109 cmpSrcLoc (SrcLoc s1 l1) (UnhelpfulSrcLoc _) = LT
110 cmpSrcLoc (SrcLoc s1 l1) (SrcLoc s2 l2) = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2)
112 l1 `cmpline` l2 | l1 <# l2 = LT
116 instance Outputable SrcLoc where
117 ppr (SrcLoc src_path src_line)
118 = getPprStyle $ \ sty ->
119 if userStyle sty then
120 hcat [ text src_file, char ':', int IBOX(src_line) ]
122 if debugStyle sty then
123 hcat [ ptext src_path, char ':', int IBOX(src_line) ]
125 hcat [text "{-# LINE ", int IBOX(src_line), space,
126 char '\"', ptext src_path, text " #-}"]
128 src_file = remove_directory_prefix (unpackFS src_path)
130 remove_directory_prefix path = case break (== '/') path of
131 (filename, []) -> filename
132 (prefix, slash : rest) -> ASSERT( slash == '/' )
133 remove_directory_prefix rest
135 ppr (UnhelpfulSrcLoc s) = ptext s
137 ppr NoSrcLoc = text "<NoSrcLoc>"