2 % (c) The University of Glasgow, 1992-2006
9 mkSrcLoc, isGoodSrcLoc, mkGeneralSrcLoc,
10 noSrcLoc, -- "I'm sorry, I haven't a clue"
13 generatedSrcLoc, -- Code generated within the compiler
14 interactiveSrcLoc, -- Code from an interactive session
16 srcLocFile, -- return the file name part
17 srcLocLine, -- return the line part
18 srcLocCol, -- return the column part
23 wiredInSrcSpan, -- Something wired into the compiler
25 isGoodSrcSpan, isOneLineSpan,
26 mkSrcSpan, srcLocSpan,
28 srcSpanStart, srcSpanEnd,
31 -- These are dubious exports, because they crash on some inputs,
32 -- used only in Lexer.x where we are sure what the Span looks like
34 srcSpanStartLine, srcSpanEndLine,
35 srcSpanStartCol, srcSpanEndCol,
37 Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc,
38 leftmost_smallest, leftmost_largest, rightmost, spans, isSubspanOf
41 #include "HsVersions.h"
46 import System.FilePath
49 %************************************************************************
51 \subsection[SrcLoc-SrcLocations]{Source-location information}
53 %************************************************************************
55 We keep information about the {\em definition} point for each entity;
56 this is the obvious stuff:
59 = SrcLoc FastString -- A precise location (file name)
60 !Int -- line number, begins at 1
61 !Int -- column number, begins at 0
62 -- Don't ask me why lines start at 1 and columns start at
63 -- zero. That's just the way it is, so there. --SDM
65 | UnhelpfulLoc FastString -- Just a general indication
68 %************************************************************************
70 \subsection[SrcLoc-access-fns]{Access functions for names}
72 %************************************************************************
76 mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
77 mkSrcLoc x line col = SrcLoc x line col
79 noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
80 noSrcLoc = UnhelpfulLoc FSLIT("<no location info>")
81 generatedSrcLoc = UnhelpfulLoc FSLIT("<compiler-generated code>")
82 interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
84 mkGeneralSrcLoc :: FastString -> SrcLoc
85 mkGeneralSrcLoc = UnhelpfulLoc
87 isGoodSrcLoc :: SrcLoc -> Bool
88 isGoodSrcLoc (SrcLoc _ _ _) = True
89 isGoodSrcLoc _other = False
91 srcLocFile :: SrcLoc -> FastString
92 srcLocFile (SrcLoc fname _ _) = fname
93 srcLocFile _other = FSLIT("<unknown file")
95 srcLocLine :: SrcLoc -> Int
96 srcLocLine (SrcLoc _ l _) = l
97 srcLocLine _other = panic "srcLocLine: unknown line"
99 srcLocCol :: SrcLoc -> Int
100 srcLocCol (SrcLoc _ _ c) = c
101 srcLocCol _other = panic "srcLocCol: unknown col"
103 advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
104 advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f (l + 1) 0
105 advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c + 1)
106 advanceSrcLoc loc _ = loc -- Better than nothing
109 %************************************************************************
111 \subsection[SrcLoc-instances]{Instance declarations for various names}
113 %************************************************************************
116 -- SrcLoc is an instance of Ord so that we can sort error messages easily
117 instance Eq SrcLoc where
118 loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
122 instance Ord SrcLoc where
125 cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering
126 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
127 cmpSrcLoc (UnhelpfulLoc _) _other = LT
129 cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
130 = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
131 cmpSrcLoc (SrcLoc _ _ _) _other = GT
133 pprFastFilePath :: FastString -> SDoc
134 pprFastFilePath path = text $ normalise $ unpackFS path
136 instance Outputable SrcLoc where
137 ppr (SrcLoc src_path src_line src_col)
138 = getPprStyle $ \ sty ->
139 if userStyle sty || debugStyle sty then
140 hcat [ pprFastFilePath src_path, char ':',
142 char ':', int src_col
145 hcat [text "{-# LINE ", int src_line, space,
146 char '\"', pprFastFilePath src_path, text " #-}"]
148 ppr (UnhelpfulLoc s) = ftext s
151 %************************************************************************
153 \subsection[SrcSpan]{Source Spans}
155 %************************************************************************
159 A SrcSpan delimits a portion of a text file. It could be represented
160 by a pair of (line,column) coordinates, but in fact we optimise
161 slightly by using more compact representations for single-line and
162 zero-length spans, both of which are quite common.
164 The end position is defined to be the column *after* the end of the
165 span. That is, a span of (1,1)-(1,2) is one character long, and a
166 span of (1,1)-(1,1) is zero characters long.
169 = SrcSpanOneLine -- a common case: a single line
170 { srcSpanFile :: FastString,
177 { srcSpanFile :: FastString,
178 srcSpanSLine :: !Int,
180 srcSpanELine :: !Int,
185 { srcSpanFile :: FastString,
190 | UnhelpfulSpan FastString -- Just a general indication
191 -- also used to indicate an empty span
194 deriving (Eq, Show) -- Show is used by Lexer.x, becuase we
195 -- derive Show for Token
200 -- We want to order SrcSpans first by the start point, then by the end point.
201 instance Ord SrcSpan where
203 (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
204 (srcSpanEnd a `compare` srcSpanEnd b)
206 noSrcSpan, wiredInSrcSpan :: SrcSpan
207 noSrcSpan = UnhelpfulSpan FSLIT("<no location info>")
208 wiredInSrcSpan = UnhelpfulSpan FSLIT("<wired into compiler>")
210 mkGeneralSrcSpan :: FastString -> SrcSpan
211 mkGeneralSrcSpan = UnhelpfulSpan
213 isGoodSrcSpan :: SrcSpan -> Bool
214 isGoodSrcSpan SrcSpanOneLine{} = True
215 isGoodSrcSpan SrcSpanMultiLine{} = True
216 isGoodSrcSpan SrcSpanPoint{} = True
217 isGoodSrcSpan _ = False
219 optSrcSpanFileName :: SrcSpan -> Maybe FastString
220 optSrcSpanFileName (SrcSpanOneLine { srcSpanFile = nm }) = Just nm
221 optSrcSpanFileName (SrcSpanMultiLine { srcSpanFile = nm }) = Just nm
222 optSrcSpanFileName (SrcSpanPoint { srcSpanFile = nm}) = Just nm
223 optSrcSpanFileName _ = Nothing
225 isOneLineSpan :: SrcSpan -> Bool
226 -- True if the span is known to straddle more than one line
227 -- By default, it returns False
229 | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s
232 --------------------------------------------------------
233 -- Don't export these four;
234 -- they panic on Unhelpful.
235 -- They are for internal use only
236 -- Urk! Some are needed for Lexer.x; see comment in export list
238 srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol
241 srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
242 srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
243 srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
244 srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine"
246 srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
247 srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
248 srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
249 srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine"
251 srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
252 srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
253 srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
254 srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol"
256 srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
257 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
258 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
259 srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
260 --------------------------------------------------------
262 srcSpanStart, srcSpanEnd :: SrcSpan -> SrcLoc
264 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
265 srcSpanStart s = mkSrcLoc (srcSpanFile s)
269 srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
271 mkSrcLoc (srcSpanFile s)
275 srcLocSpan :: SrcLoc -> SrcSpan
276 srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
277 srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
279 mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
280 mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
281 mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
283 | line1 == line2 = if col1 == col2
284 then SrcSpanPoint file line1 col1
285 else SrcSpanOneLine file line1 col1 col2
286 | otherwise = SrcSpanMultiLine file line1 col1 line2 col2
288 line1 = srcLocLine loc1
289 line2 = srcLocLine loc2
290 col1 = srcLocCol loc1
291 col2 = srcLocCol loc2
292 file = srcLocFile loc1
294 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
295 -- Assumes the 'file' part is the same in both
296 combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
297 combineSrcSpans l (UnhelpfulSpan _) = l
298 combineSrcSpans start end
299 = case line1 `compare` line2 of
300 EQ -> case col1 `compare` col2 of
301 EQ -> SrcSpanPoint file line1 col1
302 LT -> SrcSpanOneLine file line1 col1 col2
303 GT -> SrcSpanOneLine file line1 col2 col1
304 LT -> SrcSpanMultiLine file line1 col1 line2 col2
305 GT -> SrcSpanMultiLine file line2 col2 line1 col1
307 line1 = srcSpanStartLine start
308 col1 = srcSpanStartCol start
309 line2 = srcSpanEndLine end
310 col2 = srcSpanEndCol end
311 file = srcSpanFile start
313 pprDefnLoc :: SrcSpan -> SDoc
316 | isGoodSrcSpan loc = ptext SLIT("Defined at") <+> ppr loc
317 | otherwise = ppr loc
319 instance Outputable SrcSpan where
321 = getPprStyle $ \ sty ->
322 if userStyle sty || debugStyle sty then
325 hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
326 char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
329 pprUserSpan :: SrcSpan -> SDoc
330 pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
331 = hcat [ pprFastFilePath src_path, char ':',
333 char ':', int start_col
335 <> if end_col - start_col <= 1
337 -- for single-character or point spans, we just output the starting
339 else char '-' <> int (end_col-1)
341 pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
342 = hcat [ pprFastFilePath src_path, char ':',
343 parens (int sline <> char ',' <> int scol),
345 parens (int eline <> char ',' <>
346 if ecol == 0 then int ecol else int (ecol-1))
349 pprUserSpan (SrcSpanPoint src_path line col)
350 = hcat [ pprFastFilePath src_path, char ':',
355 pprUserSpan (UnhelpfulSpan s) = ftext s
358 %************************************************************************
360 \subsection[Located]{Attaching SrcSpans to things}
362 %************************************************************************
365 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
366 data Located e = L SrcSpan e
368 unLoc :: Located e -> e
371 getLoc :: Located e -> SrcSpan
374 noLoc :: e -> Located e
375 noLoc e = L noSrcSpan e
377 combineLocs :: Located a -> Located b -> SrcSpan
378 combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
380 addCLoc :: Located a -> Located b -> c -> Located c
381 addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
383 -- not clear whether to add a general Eq instance, but this is useful sometimes:
384 eqLocated :: Eq a => Located a -> Located a -> Bool
385 eqLocated a b = unLoc a == unLoc b
387 -- not clear whether to add a general Eq instance, but this is useful sometimes:
388 cmpLocated :: Ord a => Located a -> Located a -> Ordering
389 cmpLocated a b = unLoc a `compare` unLoc b
391 instance Functor Located where
392 fmap f (L l e) = L l (f e)
394 instance Outputable e => Outputable (Located e) where
396 -- do we want to dump the span in debugSty mode?
400 %************************************************************************
402 \subsection{Manipulating SrcSpans}
404 %************************************************************************
407 leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
408 rightmost = flip compare
409 leftmost_smallest = compare
410 leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
412 (srcSpanEnd b `compare` srcSpanEnd a)
415 spans :: SrcSpan -> (Int,Int) -> Bool
416 spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
417 where loc = mkSrcLoc (srcSpanFile span) l c
419 isSubspanOf :: SrcSpan -> SrcSpan -> Bool
420 isSubspanOf src parent
421 | optSrcSpanFileName parent /= optSrcSpanFileName src = False
422 | otherwise = srcSpanStart parent <= srcSpanStart src &&
423 srcSpanEnd parent >= srcSpanEnd src