362a925992501aa1078c799f403a6563690239b5
[ghc.git] / compiler / basicTypes / SrcLoc.hs
1 -- (c) The University of Glasgow, 1992-2006
2
3 {-# LANGUAGE CPP #-}
4 {-# LANGUAGE DeriveDataTypeable #-}
5 {-# LANGUAGE StandaloneDeriving #-}
6 {-# LANGUAGE DeriveFoldable #-}
7 {-# LANGUAGE DeriveTraversable #-}
8 {-# LANGUAGE FlexibleInstances #-}
9 {-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
10 -- Workaround for Trac #5252 crashes the bootstrap compiler without -O
11 -- When the earliest compiler we want to boostrap with is
12 -- GHC 7.2, we can make RealSrcLoc properly abstract
13
14 -- | This module contains types that relate to the positions of things
15 -- in source files, and allow tagging of those things with locations
16 module SrcLoc (
17 -- * SrcLoc
18 RealSrcLoc, -- Abstract
19 SrcLoc(..),
20
21 -- ** Constructing SrcLoc
22 mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc,
23
24 noSrcLoc, -- "I'm sorry, I haven't a clue"
25 generatedSrcLoc, -- Code generated within the compiler
26 interactiveSrcLoc, -- Code from an interactive session
27
28 advanceSrcLoc,
29
30 -- ** Unsafely deconstructing SrcLoc
31 -- These are dubious exports, because they crash on some inputs
32 srcLocFile, -- return the file name part
33 srcLocLine, -- return the line part
34 srcLocCol, -- return the column part
35
36 -- * SrcSpan
37 RealSrcSpan, -- Abstract
38 SrcSpan(..),
39
40 -- ** Constructing SrcSpan
41 mkGeneralSrcSpan, mkSrcSpan, mkRealSrcSpan,
42 noSrcSpan,
43 wiredInSrcSpan, -- Something wired into the compiler
44 srcLocSpan, realSrcLocSpan,
45 combineSrcSpans,
46
47 -- ** Deconstructing SrcSpan
48 srcSpanStart, srcSpanEnd,
49 realSrcSpanStart, realSrcSpanEnd,
50 srcSpanFileName_maybe,
51 pprUserRealSpan,
52
53 -- ** Unsafely deconstructing SrcSpan
54 -- These are dubious exports, because they crash on some inputs
55 srcSpanFile,
56 srcSpanStartLine, srcSpanEndLine,
57 srcSpanStartCol, srcSpanEndCol,
58
59 -- ** Predicates on SrcSpan
60 isGoodSrcSpan, isOneLineSpan,
61 containsSpan,
62
63 -- * Located
64 Located,
65 RealLocated,
66 GenLocated(..),
67
68 -- ** Constructing Located
69 noLoc,
70 mkGeneralLocated,
71
72 -- ** Deconstructing Located
73 getLoc, unLoc,
74
75 -- ** Combining and comparing Located values
76 eqLocated, cmpLocated, combineLocs, addCLoc,
77 leftmost_smallest, leftmost_largest, rightmost,
78 spans, isSubspanOf, sortLocated
79 ) where
80
81 import Util
82 import Outputable
83 import FastString
84
85 #if __GLASGOW_HASKELL__ < 709
86 import Data.Foldable ( Foldable )
87 import Data.Traversable ( Traversable )
88 #endif
89 import Data.Bits
90 import Data.Data
91 import Data.List
92 import Data.Ord
93
94 {-
95 ************************************************************************
96 * *
97 \subsection[SrcLoc-SrcLocations]{Source-location information}
98 * *
99 ************************************************************************
100
101 We keep information about the {\em definition} point for each entity;
102 this is the obvious stuff:
103 -}
104
105 -- | Represents a single point within a file
106 data RealSrcLoc
107 = SrcLoc FastString -- A precise location (file name)
108 {-# UNPACK #-} !Int -- line number, begins at 1
109 {-# UNPACK #-} !Int -- column number, begins at 1
110
111 data SrcLoc
112 = RealSrcLoc {-# UNPACK #-}!RealSrcLoc
113 | UnhelpfulLoc FastString -- Just a general indication
114 deriving Show
115
116 {-
117 ************************************************************************
118 * *
119 \subsection[SrcLoc-access-fns]{Access functions}
120 * *
121 ************************************************************************
122 -}
123
124 mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
125 mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col)
126
127 mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc
128 mkRealSrcLoc x line col = SrcLoc x line col
129
130 -- | Built-in "bad" 'SrcLoc' values for particular locations
131 noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
132 noSrcLoc = UnhelpfulLoc (fsLit "<no location info>")
133 generatedSrcLoc = UnhelpfulLoc (fsLit "<compiler-generated code>")
134 interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive session>")
135
136 -- | Creates a "bad" 'SrcLoc' that has no detailed information about its location
137 mkGeneralSrcLoc :: FastString -> SrcLoc
138 mkGeneralSrcLoc = UnhelpfulLoc
139
140 -- | Gives the filename of the 'RealSrcLoc'
141 srcLocFile :: RealSrcLoc -> FastString
142 srcLocFile (SrcLoc fname _ _) = fname
143
144 -- | Raises an error when used on a "bad" 'SrcLoc'
145 srcLocLine :: RealSrcLoc -> Int
146 srcLocLine (SrcLoc _ l _) = l
147
148 -- | Raises an error when used on a "bad" 'SrcLoc'
149 srcLocCol :: RealSrcLoc -> Int
150 srcLocCol (SrcLoc _ _ c) = c
151
152 -- | Move the 'SrcLoc' down by one line if the character is a newline,
153 -- to the next 8-char tabstop if it is a tab, and across by one
154 -- character in any other case
155 advanceSrcLoc :: RealSrcLoc -> Char -> RealSrcLoc
156 advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f (l + 1) 1
157 advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f l (((((c - 1) `shiftR` 3) + 1)
158 `shiftL` 3) + 1)
159 advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c + 1)
160
161 {-
162 ************************************************************************
163 * *
164 \subsection[SrcLoc-instances]{Instance declarations for various names}
165 * *
166 ************************************************************************
167 -}
168
169 -- SrcLoc is an instance of Ord so that we can sort error messages easily
170 instance Eq SrcLoc where
171 loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
172 EQ -> True
173 _other -> False
174
175 instance Eq RealSrcLoc where
176 loc1 == loc2 = case loc1 `cmpRealSrcLoc` loc2 of
177 EQ -> True
178 _other -> False
179
180 instance Ord SrcLoc where
181 compare = cmpSrcLoc
182
183 instance Ord RealSrcLoc where
184 compare = cmpRealSrcLoc
185
186 sortLocated :: [Located a] -> [Located a]
187 sortLocated things = sortBy (comparing getLoc) things
188
189 cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering
190 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
191 cmpSrcLoc (UnhelpfulLoc _) (RealSrcLoc _) = GT
192 cmpSrcLoc (RealSrcLoc _) (UnhelpfulLoc _) = LT
193 cmpSrcLoc (RealSrcLoc l1) (RealSrcLoc l2) = (l1 `compare` l2)
194
195 cmpRealSrcLoc :: RealSrcLoc -> RealSrcLoc -> Ordering
196 cmpRealSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
197 = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
198
199 instance Outputable RealSrcLoc where
200 ppr (SrcLoc src_path src_line src_col)
201 = hcat [ pprFastFilePath src_path <> colon
202 , int src_line <> colon
203 , int src_col ]
204
205 -- I don't know why there is this style-based difference
206 -- if userStyle sty || debugStyle sty then
207 -- hcat [ pprFastFilePath src_path, char ':',
208 -- int src_line,
209 -- char ':', int src_col
210 -- ]
211 -- else
212 -- hcat [text "{-# LINE ", int src_line, space,
213 -- char '\"', pprFastFilePath src_path, text " #-}"]
214
215 instance Outputable SrcLoc where
216 ppr (RealSrcLoc l) = ppr l
217 ppr (UnhelpfulLoc s) = ftext s
218
219 instance Data RealSrcSpan where
220 -- don't traverse?
221 toConstr _ = abstractConstr "RealSrcSpan"
222 gunfold _ _ = error "gunfold"
223 dataTypeOf _ = mkNoRepType "RealSrcSpan"
224
225 instance Data SrcSpan where
226 -- don't traverse?
227 toConstr _ = abstractConstr "SrcSpan"
228 gunfold _ _ = error "gunfold"
229 dataTypeOf _ = mkNoRepType "SrcSpan"
230
231 {-
232 ************************************************************************
233 * *
234 \subsection[SrcSpan]{Source Spans}
235 * *
236 ************************************************************************
237 -}
238
239 {- |
240 A SrcSpan delimits a portion of a text file. It could be represented
241 by a pair of (line,column) coordinates, but in fact we optimise
242 slightly by using more compact representations for single-line and
243 zero-length spans, both of which are quite common.
244
245 The end position is defined to be the column /after/ the end of the
246 span. That is, a span of (1,1)-(1,2) is one character long, and a
247 span of (1,1)-(1,1) is zero characters long.
248 -}
249 data RealSrcSpan
250 = SrcSpanOneLine -- a common case: a single line
251 { srcSpanFile :: !FastString,
252 srcSpanLine :: {-# UNPACK #-} !Int,
253 srcSpanSCol :: {-# UNPACK #-} !Int,
254 srcSpanECol :: {-# UNPACK #-} !Int
255 }
256
257 | SrcSpanMultiLine
258 { srcSpanFile :: !FastString,
259 srcSpanSLine :: {-# UNPACK #-} !Int,
260 srcSpanSCol :: {-# UNPACK #-} !Int,
261 srcSpanELine :: {-# UNPACK #-} !Int,
262 srcSpanECol :: {-# UNPACK #-} !Int
263 }
264
265 | SrcSpanPoint
266 { srcSpanFile :: !FastString,
267 srcSpanLine :: {-# UNPACK #-} !Int,
268 srcSpanCol :: {-# UNPACK #-} !Int
269 }
270 deriving (Eq, Typeable)
271
272 data SrcSpan =
273 RealSrcSpan !RealSrcSpan
274 | UnhelpfulSpan !FastString -- Just a general indication
275 -- also used to indicate an empty span
276
277 deriving (Eq, Ord, Typeable, Show) -- Show is used by Lexer.x, because we
278 -- derive Show for Token
279
280 -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
281 noSrcSpan, wiredInSrcSpan :: SrcSpan
282 noSrcSpan = UnhelpfulSpan (fsLit "<no location info>")
283 wiredInSrcSpan = UnhelpfulSpan (fsLit "<wired into compiler>")
284
285 -- | Create a "bad" 'SrcSpan' that has not location information
286 mkGeneralSrcSpan :: FastString -> SrcSpan
287 mkGeneralSrcSpan = UnhelpfulSpan
288
289 -- | Create a 'SrcSpan' corresponding to a single point
290 srcLocSpan :: SrcLoc -> SrcSpan
291 srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
292 srcLocSpan (RealSrcLoc l) = RealSrcSpan (realSrcLocSpan l)
293
294 realSrcLocSpan :: RealSrcLoc -> RealSrcSpan
295 realSrcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
296
297 -- | Create a 'SrcSpan' between two points in a file
298 mkRealSrcSpan :: RealSrcLoc -> RealSrcLoc -> RealSrcSpan
299 mkRealSrcSpan loc1 loc2
300 | line1 == line2 = if col1 == col2
301 then SrcSpanPoint file line1 col1
302 else SrcSpanOneLine file line1 col1 col2
303 | otherwise = SrcSpanMultiLine file line1 col1 line2 col2
304 where
305 line1 = srcLocLine loc1
306 line2 = srcLocLine loc2
307 col1 = srcLocCol loc1
308 col2 = srcLocCol loc2
309 file = srcLocFile loc1
310
311 -- | Create a 'SrcSpan' between two points in a file
312 mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
313 mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
314 mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
315 mkSrcSpan (RealSrcLoc loc1) (RealSrcLoc loc2)
316 = RealSrcSpan (mkRealSrcSpan loc1 loc2)
317
318 -- | Combines two 'SrcSpan' into one that spans at least all the characters
319 -- within both spans. Assumes the "file" part is the same in both inputs
320 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
321 combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
322 combineSrcSpans l (UnhelpfulSpan _) = l
323 combineSrcSpans (RealSrcSpan span1) (RealSrcSpan span2)
324 = RealSrcSpan (combineRealSrcSpans span1 span2)
325
326 -- | Combines two 'SrcSpan' into one that spans at least all the characters
327 -- within both spans. Assumes the "file" part is the same in both inputs
328 combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
329 combineRealSrcSpans span1 span2
330 = if line_start == line_end
331 then if col_start == col_end
332 then SrcSpanPoint file line_start col_start
333 else SrcSpanOneLine file line_start col_start col_end
334 else SrcSpanMultiLine file line_start col_start line_end col_end
335 where
336 (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)
337 (srcSpanStartLine span2, srcSpanStartCol span2)
338 (line_end, col_end) = max (srcSpanEndLine span1, srcSpanEndCol span1)
339 (srcSpanEndLine span2, srcSpanEndCol span2)
340 file = srcSpanFile span1
341
342 {-
343 ************************************************************************
344 * *
345 \subsection[SrcSpan-predicates]{Predicates}
346 * *
347 ************************************************************************
348 -}
349
350 -- | Test if a 'SrcSpan' is "good", i.e. has precise location information
351 isGoodSrcSpan :: SrcSpan -> Bool
352 isGoodSrcSpan (RealSrcSpan _) = True
353 isGoodSrcSpan (UnhelpfulSpan _) = False
354
355 isOneLineSpan :: SrcSpan -> Bool
356 -- ^ True if the span is known to straddle only one line.
357 -- For "bad" 'SrcSpan', it returns False
358 isOneLineSpan (RealSrcSpan s) = srcSpanStartLine s == srcSpanEndLine s
359 isOneLineSpan (UnhelpfulSpan _) = False
360
361 -- | Tests whether the first span "contains" the other span, meaning
362 -- that it covers at least as much source code. True where spans are equal.
363 containsSpan :: RealSrcSpan -> RealSrcSpan -> Bool
364 containsSpan s1 s2
365 = srcSpanFile s1 == srcSpanFile s2
366 && (srcSpanStartLine s1, srcSpanStartCol s1)
367 <= (srcSpanStartLine s2, srcSpanStartCol s2)
368 && (srcSpanEndLine s1, srcSpanEndCol s1)
369 >= (srcSpanEndLine s2, srcSpanEndCol s2)
370
371 {-
372 %************************************************************************
373 %* *
374 \subsection[SrcSpan-unsafe-access-fns]{Unsafe access functions}
375 * *
376 ************************************************************************
377 -}
378
379 srcSpanStartLine :: RealSrcSpan -> Int
380 srcSpanEndLine :: RealSrcSpan -> Int
381 srcSpanStartCol :: RealSrcSpan -> Int
382 srcSpanEndCol :: RealSrcSpan -> Int
383
384 srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
385 srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
386 srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
387
388 srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
389 srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
390 srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
391
392 srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
393 srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
394 srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
395
396 srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
397 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
398 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
399
400 {-
401 ************************************************************************
402 * *
403 \subsection[SrcSpan-access-fns]{Access functions}
404 * *
405 ************************************************************************
406 -}
407
408 -- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
409 srcSpanStart :: SrcSpan -> SrcLoc
410 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
411 srcSpanStart (RealSrcSpan s) = RealSrcLoc (realSrcSpanStart s)
412
413 -- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
414 srcSpanEnd :: SrcSpan -> SrcLoc
415 srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
416 srcSpanEnd (RealSrcSpan s) = RealSrcLoc (realSrcSpanEnd s)
417
418 realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
419 realSrcSpanStart s = mkRealSrcLoc (srcSpanFile s)
420 (srcSpanStartLine s)
421 (srcSpanStartCol s)
422
423 realSrcSpanEnd :: RealSrcSpan -> RealSrcLoc
424 realSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s)
425 (srcSpanEndLine s)
426 (srcSpanEndCol s)
427
428 -- | Obtains the filename for a 'SrcSpan' if it is "good"
429 srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
430 srcSpanFileName_maybe (RealSrcSpan s) = Just (srcSpanFile s)
431 srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing
432
433 {-
434 ************************************************************************
435 * *
436 \subsection[SrcSpan-instances]{Instances}
437 * *
438 ************************************************************************
439 -}
440
441 -- We want to order RealSrcSpans first by the start point, then by the
442 -- end point.
443 instance Ord RealSrcSpan where
444 a `compare` b =
445 (realSrcSpanStart a `compare` realSrcSpanStart b) `thenCmp`
446 (realSrcSpanEnd a `compare` realSrcSpanEnd b)
447
448 instance Show RealSrcLoc where
449 show (SrcLoc filename row col)
450 = "SrcLoc " ++ show filename ++ " " ++ show row ++ " " ++ show col
451
452 -- Show is used by Lexer.x, because we derive Show for Token
453 instance Show RealSrcSpan where
454 show (SrcSpanOneLine file l sc ec)
455 = "SrcSpanOneLine " ++ show file ++ " "
456 ++ intercalate " " (map show [l,sc,ec])
457 show (SrcSpanMultiLine file sl sc el ec)
458 = "SrcSpanMultiLine " ++ show file ++ " "
459 ++ intercalate " " (map show [sl,sc,el,ec])
460 show (SrcSpanPoint file l c)
461 = "SrcSpanPoint " ++ show file ++ " " ++ intercalate " " (map show [l,c])
462
463
464 instance Outputable RealSrcSpan where
465 ppr span = pprUserRealSpan True span
466
467 -- I don't know why there is this style-based difference
468 -- = getPprStyle $ \ sty ->
469 -- if userStyle sty || debugStyle sty then
470 -- text (showUserRealSpan True span)
471 -- else
472 -- hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
473 -- char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
474
475 instance Outputable SrcSpan where
476 ppr span = pprUserSpan True span
477
478 -- I don't know why there is this style-based difference
479 -- = getPprStyle $ \ sty ->
480 -- if userStyle sty || debugStyle sty then
481 -- pprUserSpan True span
482 -- else
483 -- case span of
484 -- UnhelpfulSpan _ -> panic "Outputable UnhelpfulSpan"
485 -- RealSrcSpan s -> ppr s
486
487 pprUserSpan :: Bool -> SrcSpan -> SDoc
488 pprUserSpan _ (UnhelpfulSpan s) = ftext s
489 pprUserSpan show_path (RealSrcSpan s) = pprUserRealSpan show_path s
490
491 pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
492 pprUserRealSpan show_path (SrcSpanOneLine src_path line start_col end_col)
493 = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
494 , int line <> colon
495 , int start_col
496 , ppUnless (end_col - start_col <= 1) (char '-' <> int (end_col - 1)) ]
497 -- For single-character or point spans, we just
498 -- output the starting column number
499
500 pprUserRealSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
501 = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
502 , parens (int sline <> comma <> int scol)
503 , char '-'
504 , parens (int eline <> comma <> int ecol') ]
505 where
506 ecol' = if ecol == 0 then ecol else ecol - 1
507
508 pprUserRealSpan show_path (SrcSpanPoint src_path line col)
509 = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
510 , int line <> colon
511 , int col ]
512
513 {-
514 ************************************************************************
515 * *
516 \subsection[Located]{Attaching SrcSpans to things}
517 * *
518 ************************************************************************
519 -}
520
521 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
522 data GenLocated l e = L l e
523 deriving (Eq, Ord, Typeable, Data)
524 deriving instance Foldable (GenLocated l)
525 deriving instance Traversable (GenLocated l)
526
527 type Located e = GenLocated SrcSpan e
528 type RealLocated e = GenLocated RealSrcSpan e
529
530 unLoc :: GenLocated l e -> e
531 unLoc (L _ e) = e
532
533 getLoc :: GenLocated l e -> l
534 getLoc (L l _) = l
535
536 noLoc :: e -> Located e
537 noLoc e = L noSrcSpan e
538
539 mkGeneralLocated :: String -> e -> Located e
540 mkGeneralLocated s e = L (mkGeneralSrcSpan (fsLit s)) e
541
542 combineLocs :: Located a -> Located b -> SrcSpan
543 combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
544
545 -- | Combine locations from two 'Located' things and add them to a third thing
546 addCLoc :: Located a -> Located b -> c -> Located c
547 addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
548
549 -- not clear whether to add a general Eq instance, but this is useful sometimes:
550
551 -- | Tests whether the two located things are equal
552 eqLocated :: Eq a => Located a -> Located a -> Bool
553 eqLocated a b = unLoc a == unLoc b
554
555 -- not clear whether to add a general Ord instance, but this is useful sometimes:
556
557 -- | Tests the ordering of the two located things
558 cmpLocated :: Ord a => Located a -> Located a -> Ordering
559 cmpLocated a b = unLoc a `compare` unLoc b
560
561 instance Functor (GenLocated l) where
562 fmap f (L l e) = L l (f e)
563
564 instance (Outputable l, Outputable e) => Outputable (GenLocated l e) where
565 ppr (L l e) = -- TODO: We can't do this since Located was refactored into
566 -- GenLocated:
567 -- Print spans without the file name etc
568 -- ifPprDebug (braces (pprUserSpan False l))
569 ifPprDebug (braces (ppr l))
570 $$ ppr e
571
572 {-
573 ************************************************************************
574 * *
575 \subsection{Ordering SrcSpans for InteractiveUI}
576 * *
577 ************************************************************************
578 -}
579
580 -- | Alternative strategies for ordering 'SrcSpan's
581 leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
582 rightmost = flip compare
583 leftmost_smallest = compare
584 leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
585 `thenCmp`
586 (srcSpanEnd b `compare` srcSpanEnd a)
587
588 -- | Determines whether a span encloses a given line and column index
589 spans :: SrcSpan -> (Int, Int) -> Bool
590 spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"
591 spans (RealSrcSpan span) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span
592 where loc = mkRealSrcLoc (srcSpanFile span) l c
593
594 -- | Determines whether a span is enclosed by another one
595 isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other
596 -> SrcSpan -- ^ The span it may be enclosed by
597 -> Bool
598 isSubspanOf src parent
599 | srcSpanFileName_maybe parent /= srcSpanFileName_maybe src = False
600 | otherwise = srcSpanStart parent <= srcSpanStart src &&
601 srcSpanEnd parent >= srcSpanEnd src