2 % (c) The University of Glasgow, 1992-2006
6 -- | This module contains types that relate to the positions of things
7 -- in source files, and allow tagging of those things with locations
10 RealSrcLoc, -- Abstract
13 -- ** Constructing SrcLoc
14 mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc,
16 noSrcLoc, -- "I'm sorry, I haven't a clue"
17 generatedSrcLoc, -- Code generated within the compiler
18 interactiveSrcLoc, -- Code from an interactive session
22 -- ** Unsafely deconstructing SrcLoc
23 -- These are dubious exports, because they crash on some inputs
24 srcLocFile, -- return the file name part
25 srcLocLine, -- return the line part
26 srcLocCol, -- return the column part
28 -- ** Misc. operations on SrcLoc
32 RealSrcSpan, -- Abstract
35 -- ** Constructing SrcSpan
36 mkGeneralSrcSpan, mkSrcSpan, mkRealSrcSpan,
38 wiredInSrcSpan, -- Something wired into the compiler
39 srcLocSpan, realSrcLocSpan,
42 -- ** Deconstructing SrcSpan
43 srcSpanStart, srcSpanEnd,
44 realSrcSpanStart, realSrcSpanEnd,
45 srcSpanFileName_maybe,
47 -- ** Unsafely deconstructing SrcSpan
48 -- These are dubious exports, because they crash on some inputs
50 srcSpanStartLine, srcSpanEndLine,
51 srcSpanStartCol, srcSpanEndCol,
53 -- ** Predicates on SrcSpan
54 isGoodSrcSpan, isOneLineSpan,
61 -- ** Constructing Located
65 -- ** Deconstructing Located
68 -- ** Combining and comparing Located values
69 eqLocated, cmpLocated, combineLocs, addCLoc,
70 leftmost_smallest, leftmost_largest, rightmost,
84 %************************************************************************
86 \subsection[SrcLoc-SrcLocations]{Source-location information}
88 %************************************************************************
90 We keep information about the {\em definition} point for each entity;
91 this is the obvious stuff:
93 -- | Represents a single point within a file
95 = SrcLoc FastString -- A precise location (file name)
96 {-# UNPACK #-} !Int -- line number, begins at 1
97 {-# UNPACK #-} !Int -- column number, begins at 1
100 = RealSrcLoc {-# UNPACK #-}!RealSrcLoc
101 | UnhelpfulLoc FastString -- Just a general indication
104 %************************************************************************
106 \subsection[SrcLoc-access-fns]{Access functions}
108 %************************************************************************
111 mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
112 mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col)
114 mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc
115 mkRealSrcLoc x line col = SrcLoc x line col
117 -- | Built-in "bad" 'SrcLoc' values for particular locations
118 noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
119 noSrcLoc = UnhelpfulLoc (fsLit "<no location info>")
120 generatedSrcLoc = UnhelpfulLoc (fsLit "<compiler-generated code>")
121 interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive session>")
123 -- | Creates a "bad" 'SrcLoc' that has no detailed information about its location
124 mkGeneralSrcLoc :: FastString -> SrcLoc
125 mkGeneralSrcLoc = UnhelpfulLoc
127 -- | Gives the filename of the 'RealSrcLoc'
128 srcLocFile :: RealSrcLoc -> FastString
129 srcLocFile (SrcLoc fname _ _) = fname
131 -- | Raises an error when used on a "bad" 'SrcLoc'
132 srcLocLine :: RealSrcLoc -> Int
133 srcLocLine (SrcLoc _ l _) = l
135 -- | Raises an error when used on a "bad" 'SrcLoc'
136 srcLocCol :: RealSrcLoc -> Int
137 srcLocCol (SrcLoc _ _ c) = c
139 -- | Move the 'SrcLoc' down by one line if the character is a newline,
140 -- to the next 8-char tabstop if it is a tab, and across by one
141 -- character in any other case
142 advanceSrcLoc :: RealSrcLoc -> Char -> RealSrcLoc
143 advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f (l + 1) 1
144 advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f l (((((c - 1) `shiftR` 3) + 1)
146 advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c + 1)
149 %************************************************************************
151 \subsection[SrcLoc-instances]{Instance declarations for various names}
153 %************************************************************************
156 -- SrcLoc is an instance of Ord so that we can sort error messages easily
157 instance Eq SrcLoc where
158 loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
162 instance Eq RealSrcLoc where
163 loc1 == loc2 = case loc1 `cmpRealSrcLoc` loc2 of
167 instance Ord SrcLoc where
170 instance Ord RealSrcLoc where
171 compare = cmpRealSrcLoc
173 cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering
174 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
175 cmpSrcLoc (UnhelpfulLoc _) (RealSrcLoc _) = GT
176 cmpSrcLoc (RealSrcLoc _) (UnhelpfulLoc _) = LT
177 cmpSrcLoc (RealSrcLoc l1) (RealSrcLoc l2) = (l1 `compare` l2)
179 cmpRealSrcLoc :: RealSrcLoc -> RealSrcLoc -> Ordering
180 cmpRealSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
181 = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
183 instance Outputable RealSrcLoc where
184 ppr (SrcLoc src_path src_line src_col)
185 = getPprStyle $ \ sty ->
186 if userStyle sty || debugStyle sty then
187 hcat [ pprFastFilePath src_path, char ':',
189 char ':', int src_col
192 hcat [text "{-# LINE ", int src_line, space,
193 char '\"', pprFastFilePath src_path, text " #-}"]
195 instance Outputable SrcLoc where
196 ppr (RealSrcLoc l) = ppr l
197 ppr (UnhelpfulLoc s) = ftext s
199 instance Data RealSrcSpan where
201 toConstr _ = abstractConstr "RealSrcSpan"
202 gunfold _ _ = error "gunfold"
203 dataTypeOf _ = mkNoRepType "RealSrcSpan"
205 instance Data SrcSpan where
207 toConstr _ = abstractConstr "SrcSpan"
208 gunfold _ _ = error "gunfold"
209 dataTypeOf _ = mkNoRepType "SrcSpan"
212 %************************************************************************
214 \subsection[SrcSpan]{Source Spans}
216 %************************************************************************
220 A SrcSpan delimits a portion of a text file. It could be represented
221 by a pair of (line,column) coordinates, but in fact we optimise
222 slightly by using more compact representations for single-line and
223 zero-length spans, both of which are quite common.
225 The end position is defined to be the column /after/ the end of the
226 span. That is, a span of (1,1)-(1,2) is one character long, and a
227 span of (1,1)-(1,1) is zero characters long.
230 = SrcSpanOneLine -- a common case: a single line
231 { srcSpanFile :: !FastString,
232 srcSpanLine :: {-# UNPACK #-} !Int,
233 srcSpanSCol :: {-# UNPACK #-} !Int,
234 srcSpanECol :: {-# UNPACK #-} !Int
238 { srcSpanFile :: !FastString,
239 srcSpanSLine :: {-# UNPACK #-} !Int,
240 srcSpanSCol :: {-# UNPACK #-} !Int,
241 srcSpanELine :: {-# UNPACK #-} !Int,
242 srcSpanECol :: {-# UNPACK #-} !Int
246 { srcSpanFile :: !FastString,
247 srcSpanLine :: {-# UNPACK #-} !Int,
248 srcSpanCol :: {-# UNPACK #-} !Int
251 deriving (Eq, Typeable, Show) -- Show is used by Lexer.x, becuase we
252 -- derive Show for Token
254 deriving (Eq, Typeable)
258 RealSrcSpan !RealSrcSpan
259 | UnhelpfulSpan !FastString -- Just a general indication
260 -- also used to indicate an empty span
263 deriving (Eq, Typeable, Show) -- Show is used by Lexer.x, becuase we
264 -- derive Show for Token
266 deriving (Eq, Typeable)
269 -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
270 noSrcSpan, wiredInSrcSpan :: SrcSpan
271 noSrcSpan = UnhelpfulSpan (fsLit "<no location info>")
272 wiredInSrcSpan = UnhelpfulSpan (fsLit "<wired into compiler>")
274 -- | Create a "bad" 'SrcSpan' that has not location information
275 mkGeneralSrcSpan :: FastString -> SrcSpan
276 mkGeneralSrcSpan = UnhelpfulSpan
278 -- | Create a 'SrcSpan' corresponding to a single point
279 srcLocSpan :: SrcLoc -> SrcSpan
280 srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
281 srcLocSpan (RealSrcLoc l) = RealSrcSpan (realSrcLocSpan l)
283 realSrcLocSpan :: RealSrcLoc -> RealSrcSpan
284 realSrcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
286 -- | Create a 'SrcSpan' between two points in a file
287 mkRealSrcSpan :: RealSrcLoc -> RealSrcLoc -> RealSrcSpan
288 mkRealSrcSpan loc1 loc2
289 | line1 == line2 = if col1 == col2
290 then SrcSpanPoint file line1 col1
291 else SrcSpanOneLine file line1 col1 col2
292 | otherwise = SrcSpanMultiLine file line1 col1 line2 col2
294 line1 = srcLocLine loc1
295 line2 = srcLocLine loc2
296 col1 = srcLocCol loc1
297 col2 = srcLocCol loc2
298 file = srcLocFile loc1
300 -- | Create a 'SrcSpan' between two points in a file
301 mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
302 mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
303 mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
304 mkSrcSpan (RealSrcLoc loc1) (RealSrcLoc loc2)
305 = RealSrcSpan (mkRealSrcSpan loc1 loc2)
307 -- | Combines two 'SrcSpan' into one that spans at least all the characters
308 -- within both spans. Assumes the "file" part is the same in both inputs
309 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
310 combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
311 combineSrcSpans l (UnhelpfulSpan _) = l
312 combineSrcSpans (RealSrcSpan span1) (RealSrcSpan span2)
313 = RealSrcSpan (combineRealSrcSpans span1 span2)
315 -- | Combines two 'SrcSpan' into one that spans at least all the characters
316 -- within both spans. Assumes the "file" part is the same in both inputs
317 combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
318 combineRealSrcSpans span1 span2
319 = if line_start == line_end
320 then if col_start == col_end
321 then SrcSpanPoint file line_start col_start
322 else SrcSpanOneLine file line_start col_start col_end
323 else SrcSpanMultiLine file line_start col_start line_end col_end
325 (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)
326 (srcSpanStartLine span2, srcSpanStartCol span2)
327 (line_end, col_end) = max (srcSpanEndLine span1, srcSpanEndCol span1)
328 (srcSpanEndLine span2, srcSpanEndCol span2)
329 file = srcSpanFile span1
332 %************************************************************************
334 \subsection[SrcSpan-predicates]{Predicates}
336 %************************************************************************
339 -- | Test if a 'SrcSpan' is "good", i.e. has precise location information
340 isGoodSrcSpan :: SrcSpan -> Bool
341 isGoodSrcSpan (RealSrcSpan _) = True
342 isGoodSrcSpan (UnhelpfulSpan _) = False
344 isOneLineSpan :: SrcSpan -> Bool
345 -- ^ True if the span is known to straddle only one line.
346 -- For "bad" 'SrcSpan', it returns False
347 isOneLineSpan (RealSrcSpan s) = srcSpanStartLine s == srcSpanEndLine s
348 isOneLineSpan (UnhelpfulSpan _) = False
352 %************************************************************************
354 \subsection[SrcSpan-unsafe-access-fns]{Unsafe access functions}
356 %************************************************************************
360 srcSpanStartLine :: RealSrcSpan -> Int
361 srcSpanEndLine :: RealSrcSpan -> Int
362 srcSpanStartCol :: RealSrcSpan -> Int
363 srcSpanEndCol :: RealSrcSpan -> Int
365 srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
366 srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
367 srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
369 srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
370 srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
371 srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
373 srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
374 srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
375 srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
377 srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
378 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
379 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
383 %************************************************************************
385 \subsection[SrcSpan-access-fns]{Access functions}
387 %************************************************************************
391 -- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
392 srcSpanStart :: SrcSpan -> SrcLoc
393 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
394 srcSpanStart (RealSrcSpan s) = RealSrcLoc (realSrcSpanStart s)
396 -- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
397 srcSpanEnd :: SrcSpan -> SrcLoc
398 srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
399 srcSpanEnd (RealSrcSpan s) = RealSrcLoc (realSrcSpanEnd s)
401 realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
402 realSrcSpanStart s = mkRealSrcLoc (srcSpanFile s)
406 realSrcSpanEnd :: RealSrcSpan -> RealSrcLoc
407 realSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s)
411 -- | Obtains the filename for a 'SrcSpan' if it is "good"
412 srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
413 srcSpanFileName_maybe (RealSrcSpan s) = Just (srcSpanFile s)
414 srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing
418 %************************************************************************
420 \subsection[SrcSpan-instances]{Instances}
422 %************************************************************************
426 -- We want to order SrcSpans first by the start point, then by the end point.
427 instance Ord SrcSpan where
429 (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
430 (srcSpanEnd a `compare` srcSpanEnd b)
433 instance Outputable RealSrcSpan where
435 = getPprStyle $ \ sty ->
436 if userStyle sty || debugStyle sty then
437 pprUserRealSpan True span
439 hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
440 char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
442 instance Outputable SrcSpan where
444 = getPprStyle $ \ sty ->
445 if userStyle sty || debugStyle sty then
446 pprUserSpan True span
449 UnhelpfulSpan _ -> panic "Outputable UnhelpfulSpan"
450 RealSrcSpan s -> ppr s
452 pprUserSpan :: Bool -> SrcSpan -> SDoc
453 pprUserSpan _ (UnhelpfulSpan s) = ftext s
454 pprUserSpan show_path (RealSrcSpan s) = pprUserRealSpan show_path s
456 pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
457 pprUserRealSpan show_path (SrcSpanOneLine src_path line start_col end_col)
458 = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
459 , int line, char ':', int start_col
460 , ppUnless (end_col - start_col <= 1)
461 (char '-' <> int (end_col-1))
462 -- For single-character or point spans, we just
463 -- output the starting column number
467 pprUserRealSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
468 = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
469 , parens (int sline <> char ',' <> int scol)
471 , parens (int eline <> char ',' <>
472 if ecol == 0 then int ecol else int (ecol-1))
475 pprUserRealSpan show_path (SrcSpanPoint src_path line col)
476 = hcat [ ppWhen show_path $ (pprFastFilePath src_path <> colon)
477 , int line, char ':', int col ]
479 pprDefnLoc :: RealSrcSpan -> SDoc
480 -- ^ Pretty prints information about the 'SrcSpan' in the style "defined at ..."
481 pprDefnLoc loc = ptext (sLit "Defined at") <+> ppr loc
484 %************************************************************************
486 \subsection[Located]{Attaching SrcSpans to things}
488 %************************************************************************
491 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
492 data GenLocated l e = L l e
493 deriving (Eq, Ord, Typeable, Data)
495 type Located e = GenLocated SrcSpan e
496 type RealLocated e = GenLocated RealSrcSpan e
498 unLoc :: GenLocated l e -> e
501 getLoc :: GenLocated l e -> l
504 noLoc :: e -> Located e
505 noLoc e = L noSrcSpan e
507 mkGeneralLocated :: String -> e -> Located e
508 mkGeneralLocated s e = L (mkGeneralSrcSpan (fsLit s)) e
510 combineLocs :: Located a -> Located b -> SrcSpan
511 combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
513 -- | Combine locations from two 'Located' things and add them to a third thing
514 addCLoc :: Located a -> Located b -> c -> Located c
515 addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
517 -- not clear whether to add a general Eq instance, but this is useful sometimes:
519 -- | Tests whether the two located things are equal
520 eqLocated :: Eq a => Located a -> Located a -> Bool
521 eqLocated a b = unLoc a == unLoc b
523 -- not clear whether to add a general Ord instance, but this is useful sometimes:
525 -- | Tests the ordering of the two located things
526 cmpLocated :: Ord a => Located a -> Located a -> Ordering
527 cmpLocated a b = unLoc a `compare` unLoc b
529 instance Functor (GenLocated l) where
530 fmap f (L l e) = L l (f e)
532 instance (Outputable l, Outputable e) => Outputable (GenLocated l e) where
533 ppr (L l e) = -- TODO: We can't do this since Located was refactored into
535 -- Print spans without the file name etc
536 -- ifPprDebug (braces (pprUserSpan False l))
537 ifPprDebug (braces (ppr l))
541 %************************************************************************
543 \subsection{Ordering SrcSpans for InteractiveUI}
545 %************************************************************************
548 -- | Alternative strategies for ordering 'SrcSpan's
549 leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
550 rightmost = flip compare
551 leftmost_smallest = compare
552 leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
554 (srcSpanEnd b `compare` srcSpanEnd a)
556 -- | Determines whether a span encloses a given line and column index
557 spans :: SrcSpan -> (Int, Int) -> Bool
558 spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"
559 spans (RealSrcSpan span) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span
560 where loc = mkRealSrcLoc (srcSpanFile span) l c
562 -- | Determines whether a span is enclosed by another one
563 isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other
564 -> SrcSpan -- ^ The span it may be enclosed by
566 isSubspanOf src parent
567 | srcSpanFileName_maybe parent /= srcSpanFileName_maybe src = False
568 | otherwise = srcSpanStart parent <= srcSpanStart src &&
569 srcSpanEnd parent >= srcSpanEnd src