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