2 % (c) The University of Glasgow, 1992-2006
6 {-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
7 -- Workaround for Trac #5252 crashes the bootstrap compiler without -O
8 -- When the earliest compiler we want to boostrap with is
9 -- GHC 7.2, we can make RealSrcLoc properly abstract
12 -- | This module contains types that relate to the positions of things
13 -- in source files, and allow tagging of those things with locations
16 RealSrcLoc, -- Abstract
19 -- ** Constructing SrcLoc
20 mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc,
22 noSrcLoc, -- "I'm sorry, I haven't a clue"
23 generatedSrcLoc, -- Code generated within the compiler
24 interactiveSrcLoc, -- Code from an interactive session
28 -- ** Unsafely deconstructing SrcLoc
29 -- These are dubious exports, because they crash on some inputs
30 srcLocFile, -- return the file name part
31 srcLocLine, -- return the line part
32 srcLocCol, -- return the column part
34 -- ** Misc. operations on SrcLoc
38 RealSrcSpan, -- Abstract
41 -- ** Constructing SrcSpan
42 mkGeneralSrcSpan, mkSrcSpan, mkRealSrcSpan,
44 wiredInSrcSpan, -- Something wired into the compiler
45 srcLocSpan, realSrcLocSpan,
48 -- ** Deconstructing SrcSpan
49 srcSpanStart, srcSpanEnd,
50 realSrcSpanStart, realSrcSpanEnd,
51 srcSpanFileName_maybe,
53 -- ** Unsafely deconstructing SrcSpan
54 -- These are dubious exports, because they crash on some inputs
56 srcSpanStartLine, srcSpanEndLine,
57 srcSpanStartCol, srcSpanEndCol,
59 -- ** Predicates on SrcSpan
60 isGoodSrcSpan, isOneLineSpan,
67 -- ** Constructing Located
71 -- ** Deconstructing Located
74 -- ** Combining and comparing Located values
75 eqLocated, cmpLocated, combineLocs, addCLoc,
76 leftmost_smallest, leftmost_largest, rightmost,
90 %************************************************************************
92 \subsection[SrcLoc-SrcLocations]{Source-location information}
94 %************************************************************************
96 We keep information about the {\em definition} point for each entity;
97 this is the obvious stuff:
99 -- | Represents a single point within a file
101 = SrcLoc FastString -- A precise location (file name)
102 {-# UNPACK #-} !Int -- line number, begins at 1
103 {-# UNPACK #-} !Int -- column number, begins at 1
106 = RealSrcLoc {-# UNPACK #-}!RealSrcLoc
107 | UnhelpfulLoc FastString -- Just a general indication
110 %************************************************************************
112 \subsection[SrcLoc-access-fns]{Access functions}
114 %************************************************************************
117 mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
118 mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col)
120 mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc
121 mkRealSrcLoc x line col = SrcLoc x line col
123 -- | Built-in "bad" 'SrcLoc' values for particular locations
124 noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
125 noSrcLoc = UnhelpfulLoc (fsLit "<no location info>")
126 generatedSrcLoc = UnhelpfulLoc (fsLit "<compiler-generated code>")
127 interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive session>")
129 -- | Creates a "bad" 'SrcLoc' that has no detailed information about its location
130 mkGeneralSrcLoc :: FastString -> SrcLoc
131 mkGeneralSrcLoc = UnhelpfulLoc
133 -- | Gives the filename of the 'RealSrcLoc'
134 srcLocFile :: RealSrcLoc -> FastString
135 srcLocFile (SrcLoc fname _ _) = fname
137 -- | Raises an error when used on a "bad" 'SrcLoc'
138 srcLocLine :: RealSrcLoc -> Int
139 srcLocLine (SrcLoc _ l _) = l
141 -- | Raises an error when used on a "bad" 'SrcLoc'
142 srcLocCol :: RealSrcLoc -> Int
143 srcLocCol (SrcLoc _ _ c) = c
145 -- | Move the 'SrcLoc' down by one line if the character is a newline,
146 -- to the next 8-char tabstop if it is a tab, and across by one
147 -- character in any other case
148 advanceSrcLoc :: RealSrcLoc -> Char -> RealSrcLoc
149 advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f (l + 1) 1
150 advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f l (((((c - 1) `shiftR` 3) + 1)
152 advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c + 1)
155 %************************************************************************
157 \subsection[SrcLoc-instances]{Instance declarations for various names}
159 %************************************************************************
162 -- SrcLoc is an instance of Ord so that we can sort error messages easily
163 instance Eq SrcLoc where
164 loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
168 instance Eq RealSrcLoc where
169 loc1 == loc2 = case loc1 `cmpRealSrcLoc` loc2 of
173 instance Ord SrcLoc where
176 instance Ord RealSrcLoc where
177 compare = cmpRealSrcLoc
179 cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering
180 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
181 cmpSrcLoc (UnhelpfulLoc _) (RealSrcLoc _) = GT
182 cmpSrcLoc (RealSrcLoc _) (UnhelpfulLoc _) = LT
183 cmpSrcLoc (RealSrcLoc l1) (RealSrcLoc l2) = (l1 `compare` l2)
185 cmpRealSrcLoc :: RealSrcLoc -> RealSrcLoc -> Ordering
186 cmpRealSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
187 = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
189 instance Outputable RealSrcLoc where
190 ppr (SrcLoc src_path src_line src_col)
191 = getPprStyle $ \ sty ->
192 if userStyle sty || debugStyle sty then
193 hcat [ pprFastFilePath src_path, char ':',
195 char ':', int src_col
198 hcat [text "{-# LINE ", int src_line, space,
199 char '\"', pprFastFilePath src_path, text " #-}"]
201 instance Outputable SrcLoc where
202 ppr (RealSrcLoc l) = ppr l
203 ppr (UnhelpfulLoc s) = ftext s
205 instance Data RealSrcSpan where
207 toConstr _ = abstractConstr "RealSrcSpan"
208 gunfold _ _ = error "gunfold"
209 dataTypeOf _ = mkNoRepType "RealSrcSpan"
211 instance Data SrcSpan where
213 toConstr _ = abstractConstr "SrcSpan"
214 gunfold _ _ = error "gunfold"
215 dataTypeOf _ = mkNoRepType "SrcSpan"
218 %************************************************************************
220 \subsection[SrcSpan]{Source Spans}
222 %************************************************************************
226 A SrcSpan delimits a portion of a text file. It could be represented
227 by a pair of (line,column) coordinates, but in fact we optimise
228 slightly by using more compact representations for single-line and
229 zero-length spans, both of which are quite common.
231 The end position is defined to be the column /after/ the end of the
232 span. That is, a span of (1,1)-(1,2) is one character long, and a
233 span of (1,1)-(1,1) is zero characters long.
236 = SrcSpanOneLine -- a common case: a single line
237 { srcSpanFile :: !FastString,
238 srcSpanLine :: {-# UNPACK #-} !Int,
239 srcSpanSCol :: {-# UNPACK #-} !Int,
240 srcSpanECol :: {-# UNPACK #-} !Int
244 { srcSpanFile :: !FastString,
245 srcSpanSLine :: {-# UNPACK #-} !Int,
246 srcSpanSCol :: {-# UNPACK #-} !Int,
247 srcSpanELine :: {-# UNPACK #-} !Int,
248 srcSpanECol :: {-# UNPACK #-} !Int
252 { srcSpanFile :: !FastString,
253 srcSpanLine :: {-# UNPACK #-} !Int,
254 srcSpanCol :: {-# UNPACK #-} !Int
257 deriving (Eq, Typeable, Show) -- Show is used by Lexer.x, becuase we
258 -- derive Show for Token
260 deriving (Eq, Typeable)
264 RealSrcSpan !RealSrcSpan
265 | UnhelpfulSpan !FastString -- Just a general indication
266 -- also used to indicate an empty span
269 deriving (Eq, Typeable, Show) -- Show is used by Lexer.x, becuase we
270 -- derive Show for Token
272 deriving (Eq, Typeable)
275 -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
276 noSrcSpan, wiredInSrcSpan :: SrcSpan
277 noSrcSpan = UnhelpfulSpan (fsLit "<no location info>")
278 wiredInSrcSpan = UnhelpfulSpan (fsLit "<wired into compiler>")
280 -- | Create a "bad" 'SrcSpan' that has not location information
281 mkGeneralSrcSpan :: FastString -> SrcSpan
282 mkGeneralSrcSpan = UnhelpfulSpan
284 -- | Create a 'SrcSpan' corresponding to a single point
285 srcLocSpan :: SrcLoc -> SrcSpan
286 srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
287 srcLocSpan (RealSrcLoc l) = RealSrcSpan (realSrcLocSpan l)
289 realSrcLocSpan :: RealSrcLoc -> RealSrcSpan
290 realSrcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
292 -- | Create a 'SrcSpan' between two points in a file
293 mkRealSrcSpan :: RealSrcLoc -> RealSrcLoc -> RealSrcSpan
294 mkRealSrcSpan loc1 loc2
295 | line1 == line2 = if col1 == col2
296 then SrcSpanPoint file line1 col1
297 else SrcSpanOneLine file line1 col1 col2
298 | otherwise = SrcSpanMultiLine file line1 col1 line2 col2
300 line1 = srcLocLine loc1
301 line2 = srcLocLine loc2
302 col1 = srcLocCol loc1
303 col2 = srcLocCol loc2
304 file = srcLocFile loc1
306 -- | Create a 'SrcSpan' between two points in a file
307 mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
308 mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
309 mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
310 mkSrcSpan (RealSrcLoc loc1) (RealSrcLoc loc2)
311 = RealSrcSpan (mkRealSrcSpan loc1 loc2)
313 -- | Combines two 'SrcSpan' into one that spans at least all the characters
314 -- within both spans. Assumes the "file" part is the same in both inputs
315 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
316 combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
317 combineSrcSpans l (UnhelpfulSpan _) = l
318 combineSrcSpans (RealSrcSpan span1) (RealSrcSpan span2)
319 = RealSrcSpan (combineRealSrcSpans span1 span2)
321 -- | Combines two 'SrcSpan' into one that spans at least all the characters
322 -- within both spans. Assumes the "file" part is the same in both inputs
323 combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
324 combineRealSrcSpans span1 span2
325 = if line_start == line_end
326 then if col_start == col_end
327 then SrcSpanPoint file line_start col_start
328 else SrcSpanOneLine file line_start col_start col_end
329 else SrcSpanMultiLine file line_start col_start line_end col_end
331 (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)
332 (srcSpanStartLine span2, srcSpanStartCol span2)
333 (line_end, col_end) = max (srcSpanEndLine span1, srcSpanEndCol span1)
334 (srcSpanEndLine span2, srcSpanEndCol span2)
335 file = srcSpanFile span1
338 %************************************************************************
340 \subsection[SrcSpan-predicates]{Predicates}
342 %************************************************************************
345 -- | Test if a 'SrcSpan' is "good", i.e. has precise location information
346 isGoodSrcSpan :: SrcSpan -> Bool
347 isGoodSrcSpan (RealSrcSpan _) = True
348 isGoodSrcSpan (UnhelpfulSpan _) = False
350 isOneLineSpan :: SrcSpan -> Bool
351 -- ^ True if the span is known to straddle only one line.
352 -- For "bad" 'SrcSpan', it returns False
353 isOneLineSpan (RealSrcSpan s) = srcSpanStartLine s == srcSpanEndLine s
354 isOneLineSpan (UnhelpfulSpan _) = False
358 %************************************************************************
360 \subsection[SrcSpan-unsafe-access-fns]{Unsafe access functions}
362 %************************************************************************
366 srcSpanStartLine :: RealSrcSpan -> Int
367 srcSpanEndLine :: RealSrcSpan -> Int
368 srcSpanStartCol :: RealSrcSpan -> Int
369 srcSpanEndCol :: RealSrcSpan -> Int
371 srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
372 srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
373 srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
375 srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
376 srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
377 srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
379 srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
380 srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
381 srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
383 srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
384 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
385 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
389 %************************************************************************
391 \subsection[SrcSpan-access-fns]{Access functions}
393 %************************************************************************
397 -- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
398 srcSpanStart :: SrcSpan -> SrcLoc
399 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
400 srcSpanStart (RealSrcSpan s) = RealSrcLoc (realSrcSpanStart s)
402 -- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
403 srcSpanEnd :: SrcSpan -> SrcLoc
404 srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
405 srcSpanEnd (RealSrcSpan s) = RealSrcLoc (realSrcSpanEnd s)
407 realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
408 realSrcSpanStart s = mkRealSrcLoc (srcSpanFile s)
412 realSrcSpanEnd :: RealSrcSpan -> RealSrcLoc
413 realSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s)
417 -- | Obtains the filename for a 'SrcSpan' if it is "good"
418 srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
419 srcSpanFileName_maybe (RealSrcSpan s) = Just (srcSpanFile s)
420 srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing
424 %************************************************************************
426 \subsection[SrcSpan-instances]{Instances}
428 %************************************************************************
432 -- We want to order SrcSpans first by the start point, then by the end point.
433 instance Ord SrcSpan where
435 (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
436 (srcSpanEnd a `compare` srcSpanEnd b)
439 instance Outputable RealSrcSpan where
441 = getPprStyle $ \ sty ->
442 if userStyle sty || debugStyle sty then
443 pprUserRealSpan True span
445 hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
446 char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
448 instance Outputable SrcSpan where
450 = getPprStyle $ \ sty ->
451 if userStyle sty || debugStyle sty then
452 pprUserSpan True span
455 UnhelpfulSpan _ -> panic "Outputable UnhelpfulSpan"
456 RealSrcSpan s -> ppr s
458 pprUserSpan :: Bool -> SrcSpan -> SDoc
459 pprUserSpan _ (UnhelpfulSpan s) = ftext s
460 pprUserSpan show_path (RealSrcSpan s) = pprUserRealSpan show_path s
462 pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
463 pprUserRealSpan show_path (SrcSpanOneLine src_path line start_col end_col)
464 = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
465 , int line, char ':', int start_col
466 , ppUnless (end_col - start_col <= 1)
467 (char '-' <> int (end_col-1))
468 -- For single-character or point spans, we just
469 -- output the starting column number
473 pprUserRealSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
474 = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
475 , parens (int sline <> char ',' <> int scol)
477 , parens (int eline <> char ',' <>
478 if ecol == 0 then int ecol else int (ecol-1))
481 pprUserRealSpan show_path (SrcSpanPoint src_path line col)
482 = hcat [ ppWhen show_path $ (pprFastFilePath src_path <> colon)
483 , int line, char ':', int col ]
485 pprDefnLoc :: RealSrcSpan -> SDoc
486 -- ^ Pretty prints information about the 'SrcSpan' in the style "defined at ..."
487 pprDefnLoc loc = ptext (sLit "Defined at") <+> ppr loc
490 %************************************************************************
492 \subsection[Located]{Attaching SrcSpans to things}
494 %************************************************************************
497 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
498 data GenLocated l e = L l e
499 deriving (Eq, Ord, Typeable, Data)
501 type Located e = GenLocated SrcSpan e
502 type RealLocated e = GenLocated RealSrcSpan e
504 unLoc :: GenLocated l e -> e
507 getLoc :: GenLocated l e -> l
510 noLoc :: e -> Located e
511 noLoc e = L noSrcSpan e
513 mkGeneralLocated :: String -> e -> Located e
514 mkGeneralLocated s e = L (mkGeneralSrcSpan (fsLit s)) e
516 combineLocs :: Located a -> Located b -> SrcSpan
517 combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
519 -- | Combine locations from two 'Located' things and add them to a third thing
520 addCLoc :: Located a -> Located b -> c -> Located c
521 addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
523 -- not clear whether to add a general Eq instance, but this is useful sometimes:
525 -- | Tests whether the two located things are equal
526 eqLocated :: Eq a => Located a -> Located a -> Bool
527 eqLocated a b = unLoc a == unLoc b
529 -- not clear whether to add a general Ord instance, but this is useful sometimes:
531 -- | Tests the ordering of the two located things
532 cmpLocated :: Ord a => Located a -> Located a -> Ordering
533 cmpLocated a b = unLoc a `compare` unLoc b
535 instance Functor (GenLocated l) where
536 fmap f (L l e) = L l (f e)
538 instance (Outputable l, Outputable e) => Outputable (GenLocated l e) where
539 ppr (L l e) = -- TODO: We can't do this since Located was refactored into
541 -- Print spans without the file name etc
542 -- ifPprDebug (braces (pprUserSpan False l))
543 ifPprDebug (braces (ppr l))
547 %************************************************************************
549 \subsection{Ordering SrcSpans for InteractiveUI}
551 %************************************************************************
554 -- | Alternative strategies for ordering 'SrcSpan's
555 leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
556 rightmost = flip compare
557 leftmost_smallest = compare
558 leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
560 (srcSpanEnd b `compare` srcSpanEnd a)
562 -- | Determines whether a span encloses a given line and column index
563 spans :: SrcSpan -> (Int, Int) -> Bool
564 spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"
565 spans (RealSrcSpan span) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span
566 where loc = mkRealSrcLoc (srcSpanFile span) l c
568 -- | Determines whether a span is enclosed by another one
569 isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other
570 -> SrcSpan -- ^ The span it may be enclosed by
572 isSubspanOf src parent
573 | srcSpanFileName_maybe parent /= srcSpanFileName_maybe src = False
574 | otherwise = srcSpanStart parent <= srcSpanStart src &&
575 srcSpanEnd parent >= srcSpanEnd src