696395f82f54043aece87966f3089032042c9585
[ghc.git] / compiler / basicTypes / SrcLoc.hs
1 -- (c) The University of Glasgow, 1992-2006
2
3 {-# LANGUAGE DeriveDataTypeable #-}
4 {-# LANGUAGE StandaloneDeriving #-}
5 {-# LANGUAGE DeriveFunctor #-}
6 {-# LANGUAGE DeriveFoldable #-}
7 {-# LANGUAGE DeriveTraversable #-}
8 {-# LANGUAGE FlexibleInstances #-}
9 {-# LANGUAGE RecordWildCards #-}
10 {-# LANGUAGE TypeFamilies #-}
11 {-# LANGUAGE ViewPatterns #-}
12 {-# LANGUAGE FlexibleContexts #-}
13 {-# LANGUAGE PatternSynonyms #-}
14
15
16 -- | This module contains types that relate to the positions of things
17 -- in source files, and allow tagging of those things with locations
18 module SrcLoc (
19 -- * SrcLoc
20 RealSrcLoc, -- Abstract
21 SrcLoc(..),
22
23 -- ** Constructing SrcLoc
24 mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc,
25
26 noSrcLoc, -- "I'm sorry, I haven't a clue"
27 generatedSrcLoc, -- Code generated within the compiler
28 interactiveSrcLoc, -- Code from an interactive session
29
30 advanceSrcLoc,
31
32 -- ** Unsafely deconstructing SrcLoc
33 -- These are dubious exports, because they crash on some inputs
34 srcLocFile, -- return the file name part
35 srcLocLine, -- return the line part
36 srcLocCol, -- return the column part
37
38 -- * SrcSpan
39 RealSrcSpan, -- Abstract
40 SrcSpan(..),
41
42 -- ** Constructing SrcSpan
43 mkGeneralSrcSpan, mkSrcSpan, mkRealSrcSpan,
44 noSrcSpan,
45 wiredInSrcSpan, -- Something wired into the compiler
46 interactiveSrcSpan,
47 srcLocSpan, realSrcLocSpan,
48 combineSrcSpans,
49 srcSpanFirstCharacter,
50
51 -- ** Deconstructing SrcSpan
52 srcSpanStart, srcSpanEnd,
53 realSrcSpanStart, realSrcSpanEnd,
54 srcSpanFileName_maybe,
55 pprUserRealSpan,
56
57 -- ** Unsafely deconstructing SrcSpan
58 -- These are dubious exports, because they crash on some inputs
59 srcSpanFile,
60 srcSpanStartLine, srcSpanEndLine,
61 srcSpanStartCol, srcSpanEndCol,
62
63 -- ** Predicates on SrcSpan
64 isGoodSrcSpan, isOneLineSpan,
65 containsSpan,
66
67 -- * Located
68 Located,
69 RealLocated,
70 GenLocated(..),
71
72 -- ** Constructing Located
73 noLoc,
74 mkGeneralLocated,
75
76 -- ** Deconstructing Located
77 getLoc, unLoc,
78 unRealSrcSpan, getRealSrcSpan,
79
80 -- ** Combining and comparing Located values
81 eqLocated, cmpLocated, combineLocs, addCLoc,
82 leftmost_smallest, leftmost_largest, rightmost,
83 spans, isSubspanOf, sortLocated,
84
85 -- ** HasSrcSpan
86 HasSrcSpan(..), SrcSpanLess, dL, cL,
87 pattern LL, onHasSrcSpan, liftL
88 ) where
89
90 import GhcPrelude
91
92 import Util
93 import Json
94 import Outputable
95 import FastString
96
97 import Control.DeepSeq
98 import Data.Bits
99 import Data.Data
100 import Data.List
101 import Data.Ord
102
103 {-
104 ************************************************************************
105 * *
106 \subsection[SrcLoc-SrcLocations]{Source-location information}
107 * *
108 ************************************************************************
109
110 We keep information about the {\em definition} point for each entity;
111 this is the obvious stuff:
112 -}
113
114 -- | Real Source Location
115 --
116 -- Represents a single point within a file
117 data RealSrcLoc
118 = SrcLoc FastString -- A precise location (file name)
119 {-# UNPACK #-} !Int -- line number, begins at 1
120 {-# UNPACK #-} !Int -- column number, begins at 1
121 deriving (Eq, Ord)
122
123 -- | Source Location
124 data SrcLoc
125 = RealSrcLoc {-# UNPACK #-}!RealSrcLoc
126 | UnhelpfulLoc FastString -- Just a general indication
127 deriving (Eq, Ord, Show)
128
129 {-
130 ************************************************************************
131 * *
132 \subsection[SrcLoc-access-fns]{Access functions}
133 * *
134 ************************************************************************
135 -}
136
137 mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
138 mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col)
139
140 mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc
141 mkRealSrcLoc x line col = SrcLoc x line col
142
143 -- | Built-in "bad" 'SrcLoc' values for particular locations
144 noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
145 noSrcLoc = UnhelpfulLoc (fsLit "<no location info>")
146 generatedSrcLoc = UnhelpfulLoc (fsLit "<compiler-generated code>")
147 interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive>")
148
149 -- | Creates a "bad" 'SrcLoc' that has no detailed information about its location
150 mkGeneralSrcLoc :: FastString -> SrcLoc
151 mkGeneralSrcLoc = UnhelpfulLoc
152
153 -- | Gives the filename of the 'RealSrcLoc'
154 srcLocFile :: RealSrcLoc -> FastString
155 srcLocFile (SrcLoc fname _ _) = fname
156
157 -- | Raises an error when used on a "bad" 'SrcLoc'
158 srcLocLine :: RealSrcLoc -> Int
159 srcLocLine (SrcLoc _ l _) = l
160
161 -- | Raises an error when used on a "bad" 'SrcLoc'
162 srcLocCol :: RealSrcLoc -> Int
163 srcLocCol (SrcLoc _ _ c) = c
164
165 -- | Move the 'SrcLoc' down by one line if the character is a newline,
166 -- to the next 8-char tabstop if it is a tab, and across by one
167 -- character in any other case
168 advanceSrcLoc :: RealSrcLoc -> Char -> RealSrcLoc
169 advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f (l + 1) 1
170 advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f l (((((c - 1) `shiftR` 3) + 1)
171 `shiftL` 3) + 1)
172 advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c + 1)
173
174 {-
175 ************************************************************************
176 * *
177 \subsection[SrcLoc-instances]{Instance declarations for various names}
178 * *
179 ************************************************************************
180 -}
181
182 sortLocated :: HasSrcSpan a => [a] -> [a]
183 sortLocated things = sortBy (comparing getLoc) things
184
185 instance Outputable RealSrcLoc where
186 ppr (SrcLoc src_path src_line src_col)
187 = hcat [ pprFastFilePath src_path <> colon
188 , int src_line <> colon
189 , int src_col ]
190
191 -- I don't know why there is this style-based difference
192 -- if userStyle sty || debugStyle sty then
193 -- hcat [ pprFastFilePath src_path, char ':',
194 -- int src_line,
195 -- char ':', int src_col
196 -- ]
197 -- else
198 -- hcat [text "{-# LINE ", int src_line, space,
199 -- char '\"', pprFastFilePath src_path, text " #-}"]
200
201 instance Outputable SrcLoc where
202 ppr (RealSrcLoc l) = ppr l
203 ppr (UnhelpfulLoc s) = ftext s
204
205 instance Data RealSrcSpan where
206 -- don't traverse?
207 toConstr _ = abstractConstr "RealSrcSpan"
208 gunfold _ _ = error "gunfold"
209 dataTypeOf _ = mkNoRepType "RealSrcSpan"
210
211 instance Data SrcSpan where
212 -- don't traverse?
213 toConstr _ = abstractConstr "SrcSpan"
214 gunfold _ _ = error "gunfold"
215 dataTypeOf _ = mkNoRepType "SrcSpan"
216
217 {-
218 ************************************************************************
219 * *
220 \subsection[SrcSpan]{Source Spans}
221 * *
222 ************************************************************************
223 -}
224
225 {- |
226 A 'RealSrcSpan' 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.
230
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.
234 -}
235
236 -- | Real Source Span
237 data RealSrcSpan
238 = RealSrcSpan'
239 { srcSpanFile :: !FastString,
240 srcSpanSLine :: {-# UNPACK #-} !Int,
241 srcSpanSCol :: {-# UNPACK #-} !Int,
242 srcSpanELine :: {-# UNPACK #-} !Int,
243 srcSpanECol :: {-# UNPACK #-} !Int
244 }
245 deriving Eq
246
247 -- | Source Span
248 --
249 -- A 'SrcSpan' identifies either a specific portion of a text file
250 -- or a human-readable description of a location.
251 data SrcSpan =
252 RealSrcSpan !RealSrcSpan
253 | UnhelpfulSpan !FastString -- Just a general indication
254 -- also used to indicate an empty span
255
256 deriving (Eq, Ord, Show) -- Show is used by Lexer.x, because we
257 -- derive Show for Token
258
259 instance ToJson SrcSpan where
260 json (UnhelpfulSpan {} ) = JSNull --JSObject [( "type", "unhelpful")]
261 json (RealSrcSpan rss) = json rss
262
263 instance ToJson RealSrcSpan where
264 json (RealSrcSpan'{..}) = JSObject [ ("file", JSString (unpackFS srcSpanFile))
265 , ("startLine", JSInt srcSpanSLine)
266 , ("startCol", JSInt srcSpanSCol)
267 , ("endLine", JSInt srcSpanELine)
268 , ("endCol", JSInt srcSpanECol)
269 ]
270
271 instance NFData SrcSpan where
272 rnf x = x `seq` ()
273
274 -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
275 noSrcSpan, wiredInSrcSpan, interactiveSrcSpan :: SrcSpan
276 noSrcSpan = UnhelpfulSpan (fsLit "<no location info>")
277 wiredInSrcSpan = UnhelpfulSpan (fsLit "<wired into compiler>")
278 interactiveSrcSpan = UnhelpfulSpan (fsLit "<interactive>")
279
280 -- | Create a "bad" 'SrcSpan' that has not location information
281 mkGeneralSrcSpan :: FastString -> SrcSpan
282 mkGeneralSrcSpan = UnhelpfulSpan
283
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)
288
289 realSrcLocSpan :: RealSrcLoc -> RealSrcSpan
290 realSrcLocSpan (SrcLoc file line col) = RealSrcSpan' file line col line col
291
292 -- | Create a 'SrcSpan' between two points in a file
293 mkRealSrcSpan :: RealSrcLoc -> RealSrcLoc -> RealSrcSpan
294 mkRealSrcSpan loc1 loc2 = RealSrcSpan' file line1 col1 line2 col2
295 where
296 line1 = srcLocLine loc1
297 line2 = srcLocLine loc2
298 col1 = srcLocCol loc1
299 col2 = srcLocCol loc2
300 file = srcLocFile loc1
301
302 -- | 'True' if the span is known to straddle only one line.
303 isOneLineRealSpan :: RealSrcSpan -> Bool
304 isOneLineRealSpan (RealSrcSpan' _ line1 _ line2 _)
305 = line1 == line2
306
307 -- | 'True' if the span is a single point
308 isPointRealSpan :: RealSrcSpan -> Bool
309 isPointRealSpan (RealSrcSpan' _ line1 col1 line2 col2)
310 = line1 == line2 && col1 == col2
311
312 -- | Create a 'SrcSpan' between two points in a file
313 mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
314 mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
315 mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
316 mkSrcSpan (RealSrcLoc loc1) (RealSrcLoc loc2)
317 = RealSrcSpan (mkRealSrcSpan loc1 loc2)
318
319 -- | Combines two 'SrcSpan' into one that spans at least all the characters
320 -- within both spans. Returns UnhelpfulSpan if the files differ.
321 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
322 combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
323 combineSrcSpans l (UnhelpfulSpan _) = l
324 combineSrcSpans (RealSrcSpan span1) (RealSrcSpan span2)
325 | srcSpanFile span1 == srcSpanFile span2
326 = RealSrcSpan (combineRealSrcSpans span1 span2)
327 | otherwise = UnhelpfulSpan (fsLit "<combineSrcSpans: files differ>")
328
329 -- | Combines two 'SrcSpan' into one that spans at least all the characters
330 -- within both spans. Assumes the "file" part is the same in both inputs
331 combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
332 combineRealSrcSpans span1 span2
333 = RealSrcSpan' file line_start col_start line_end col_end
334 where
335 (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)
336 (srcSpanStartLine span2, srcSpanStartCol span2)
337 (line_end, col_end) = max (srcSpanEndLine span1, srcSpanEndCol span1)
338 (srcSpanEndLine span2, srcSpanEndCol span2)
339 file = srcSpanFile span1
340
341 -- | Convert a SrcSpan into one that represents only its first character
342 srcSpanFirstCharacter :: SrcSpan -> SrcSpan
343 srcSpanFirstCharacter l@(UnhelpfulSpan {}) = l
344 srcSpanFirstCharacter (RealSrcSpan span) = RealSrcSpan $ mkRealSrcSpan loc1 loc2
345 where
346 loc1@(SrcLoc f l c) = realSrcSpanStart span
347 loc2 = SrcLoc f l (c+1)
348
349 {-
350 ************************************************************************
351 * *
352 \subsection[SrcSpan-predicates]{Predicates}
353 * *
354 ************************************************************************
355 -}
356
357 -- | Test if a 'SrcSpan' is "good", i.e. has precise location information
358 isGoodSrcSpan :: SrcSpan -> Bool
359 isGoodSrcSpan (RealSrcSpan _) = True
360 isGoodSrcSpan (UnhelpfulSpan _) = False
361
362 isOneLineSpan :: SrcSpan -> Bool
363 -- ^ True if the span is known to straddle only one line.
364 -- For "bad" 'SrcSpan', it returns False
365 isOneLineSpan (RealSrcSpan s) = srcSpanStartLine s == srcSpanEndLine s
366 isOneLineSpan (UnhelpfulSpan _) = False
367
368 -- | Tests whether the first span "contains" the other span, meaning
369 -- that it covers at least as much source code. True where spans are equal.
370 containsSpan :: RealSrcSpan -> RealSrcSpan -> Bool
371 containsSpan s1 s2
372 = (srcSpanStartLine s1, srcSpanStartCol s1)
373 <= (srcSpanStartLine s2, srcSpanStartCol s2)
374 && (srcSpanEndLine s1, srcSpanEndCol s1)
375 >= (srcSpanEndLine s2, srcSpanEndCol s2)
376 && (srcSpanFile s1 == srcSpanFile s2)
377 -- We check file equality last because it is (presumably?) least
378 -- likely to fail.
379 {-
380 %************************************************************************
381 %* *
382 \subsection[SrcSpan-unsafe-access-fns]{Unsafe access functions}
383 * *
384 ************************************************************************
385 -}
386
387 srcSpanStartLine :: RealSrcSpan -> Int
388 srcSpanEndLine :: RealSrcSpan -> Int
389 srcSpanStartCol :: RealSrcSpan -> Int
390 srcSpanEndCol :: RealSrcSpan -> Int
391
392 srcSpanStartLine RealSrcSpan'{ srcSpanSLine=l } = l
393 srcSpanEndLine RealSrcSpan'{ srcSpanELine=l } = l
394 srcSpanStartCol RealSrcSpan'{ srcSpanSCol=l } = l
395 srcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c
396
397 {-
398 ************************************************************************
399 * *
400 \subsection[SrcSpan-access-fns]{Access functions}
401 * *
402 ************************************************************************
403 -}
404
405 -- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
406 srcSpanStart :: SrcSpan -> SrcLoc
407 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
408 srcSpanStart (RealSrcSpan s) = RealSrcLoc (realSrcSpanStart s)
409
410 -- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
411 srcSpanEnd :: SrcSpan -> SrcLoc
412 srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
413 srcSpanEnd (RealSrcSpan s) = RealSrcLoc (realSrcSpanEnd s)
414
415 realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
416 realSrcSpanStart s = mkRealSrcLoc (srcSpanFile s)
417 (srcSpanStartLine s)
418 (srcSpanStartCol s)
419
420 realSrcSpanEnd :: RealSrcSpan -> RealSrcLoc
421 realSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s)
422 (srcSpanEndLine s)
423 (srcSpanEndCol s)
424
425 -- | Obtains the filename for a 'SrcSpan' if it is "good"
426 srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
427 srcSpanFileName_maybe (RealSrcSpan s) = Just (srcSpanFile s)
428 srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing
429
430 {-
431 ************************************************************************
432 * *
433 \subsection[SrcSpan-instances]{Instances}
434 * *
435 ************************************************************************
436 -}
437
438 -- We want to order RealSrcSpans first by the start point, then by the
439 -- end point.
440 instance Ord RealSrcSpan where
441 a `compare` b =
442 (realSrcSpanStart a `compare` realSrcSpanStart b) `thenCmp`
443 (realSrcSpanEnd a `compare` realSrcSpanEnd b)
444
445 instance Show RealSrcLoc where
446 show (SrcLoc filename row col)
447 = "SrcLoc " ++ show filename ++ " " ++ show row ++ " " ++ show col
448
449 -- Show is used by Lexer.x, because we derive Show for Token
450 instance Show RealSrcSpan where
451 show span@(RealSrcSpan' file sl sc el ec)
452 | isPointRealSpan span
453 = "SrcSpanPoint " ++ show file ++ " " ++ intercalate " " (map show [sl,sc])
454
455 | isOneLineRealSpan span
456 = "SrcSpanOneLine " ++ show file ++ " "
457 ++ intercalate " " (map show [sl,sc,ec])
458
459 | otherwise
460 = "SrcSpanMultiLine " ++ show file ++ " "
461 ++ intercalate " " (map show [sl,sc,el,ec])
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 span@(RealSrcSpan' src_path line col _ _)
493 | isPointRealSpan span
494 = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
495 , int line <> colon
496 , int col ]
497
498 pprUserRealSpan show_path span@(RealSrcSpan' src_path line scol _ ecol)
499 | isOneLineRealSpan span
500 = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
501 , int line <> colon
502 , int scol
503 , ppUnless (ecol - scol <= 1) (char '-' <> int (ecol - 1)) ]
504 -- For single-character or point spans, we just
505 -- output the starting column number
506
507 pprUserRealSpan show_path (RealSrcSpan' src_path sline scol eline ecol)
508 = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
509 , parens (int sline <> comma <> int scol)
510 , char '-'
511 , parens (int eline <> comma <> int ecol') ]
512 where
513 ecol' = if ecol == 0 then ecol else ecol - 1
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, Data, Functor, Foldable, Traversable)
526
527 type Located = GenLocated SrcSpan
528 type RealLocated = GenLocated RealSrcSpan
529
530 unLoc :: HasSrcSpan a => a -> SrcSpanLess a
531 unLoc (dL->L _ e) = e
532
533 getLoc :: HasSrcSpan a => a -> SrcSpan
534 getLoc (dL->L l _) = l
535
536 noLoc :: HasSrcSpan a => SrcSpanLess a -> a
537 noLoc e = cL noSrcSpan e
538
539 mkGeneralLocated :: HasSrcSpan e => String -> SrcSpanLess e -> e
540 mkGeneralLocated s e = cL (mkGeneralSrcSpan (fsLit s)) e
541
542 combineLocs :: (HasSrcSpan a , HasSrcSpan b) => a -> 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 :: (HasSrcSpan a , HasSrcSpan b , HasSrcSpan c) =>
547 a -> b -> SrcSpanLess c -> c
548 addCLoc a b c = cL (combineSrcSpans (getLoc a) (getLoc b)) c
549
550 -- not clear whether to add a general Eq instance, but this is useful sometimes:
551
552 -- | Tests whether the two located things are equal
553 eqLocated :: (HasSrcSpan a , Eq (SrcSpanLess a)) => a -> a -> Bool
554 eqLocated a b = unLoc a == unLoc b
555
556 -- not clear whether to add a general Ord instance, but this is useful sometimes:
557
558 -- | Tests the ordering of the two located things
559 cmpLocated :: (HasSrcSpan a , Ord (SrcSpanLess a)) => a -> a -> Ordering
560 cmpLocated a b = unLoc a `compare` unLoc b
561
562 instance (Outputable l, Outputable e) => Outputable (GenLocated l e) where
563 ppr (L l e) = -- TODO: We can't do this since Located was refactored into
564 -- GenLocated:
565 -- Print spans without the file name etc
566 -- ifPprDebug (braces (pprUserSpan False l))
567 whenPprDebug (braces (ppr l))
568 $$ ppr e
569
570 {-
571 ************************************************************************
572 * *
573 \subsection{Ordering SrcSpans for InteractiveUI}
574 * *
575 ************************************************************************
576 -}
577
578 -- | Alternative strategies for ordering 'SrcSpan's
579 leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
580 rightmost = flip compare
581 leftmost_smallest = compare
582 leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
583 `thenCmp`
584 (srcSpanEnd b `compare` srcSpanEnd a)
585
586 -- | Determines whether a span encloses a given line and column index
587 spans :: SrcSpan -> (Int, Int) -> Bool
588 spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"
589 spans (RealSrcSpan span) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span
590 where loc = mkRealSrcLoc (srcSpanFile span) l c
591
592 -- | Determines whether a span is enclosed by another one
593 isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other
594 -> SrcSpan -- ^ The span it may be enclosed by
595 -> Bool
596 isSubspanOf src parent
597 | srcSpanFileName_maybe parent /= srcSpanFileName_maybe src = False
598 | otherwise = srcSpanStart parent <= srcSpanStart src &&
599 srcSpanEnd parent >= srcSpanEnd src
600
601
602 {-
603 ************************************************************************
604 * *
605 \subsection{HasSrcSpan Typeclass to Set/Get Source Location Spans}
606 * *
607 ************************************************************************
608 -}
609
610 {-
611 Note [HasSrcSpan Typeclass]
612 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
613
614 To be able to uniformly set/get source location spans (of `SrcSpan`) in
615 syntactic entities (`HsSyn`), we use the typeclass `HasSrcSpan`.
616 More details can be found at the following wiki page
617 ImplementingTreesThatGrow/HandlingSourceLocations
618
619 For most syntactic entities, the source location spans are stored in
620 a syntactic entity by a wapper constuctor (introduced by TTG's
621 new constructor extension), e.g., by `NewPat (WrapperPat sp pat)`
622 for a source location span `sp` and a pattern `pat`.
623 -}
624
625 -- | Determines the type of undecorated syntactic entities
626 -- For most syntactic entities `E`, where source location spans are
627 -- introduced by a wrapper construtor of the same syntactic entity,
628 -- we have `SrcSpanLess E = E`.
629 -- However, some syntactic entities have a different type compared to
630 -- a syntactic entity `e :: E` may have the type `Located E` when
631 -- decorated by wrapping it with `L sp e` for a source span `sp`.
632 type family SrcSpanLess a
633
634 -- | A typeclass to set/get SrcSpans
635 class HasSrcSpan a where
636 -- | Composes a `SrcSpan` decoration with an undecorated syntactic
637 -- entity to form its decorated variant
638 composeSrcSpan :: Located (SrcSpanLess a) -> a
639
640 -- | Decomposes a decorated syntactic entity into its `SrcSpan`
641 -- decoration and its undecorated variant
642 decomposeSrcSpan :: a -> Located (SrcSpanLess a)
643 {- laws:
644 composeSrcSpan . decomposeSrcSpan = id
645 decomposeSrcSpan . composeSrcSpan = id
646
647 in other words, `HasSrcSpan` defines an iso relation between
648 a `SrcSpan`-decorated syntactic entity and its undecorated variant
649 (together with the `SrcSpan`).
650 -}
651
652 type instance SrcSpanLess (GenLocated l e) = e
653 instance HasSrcSpan (Located a) where
654 composeSrcSpan = id
655 decomposeSrcSpan = id
656
657
658 -- | An abbreviated form of decomposeSrcSpan,
659 -- mainly to be used in ViewPatterns
660 dL :: HasSrcSpan a => a -> Located (SrcSpanLess a)
661 dL = decomposeSrcSpan
662
663 -- | An abbreviated form of composeSrcSpan,
664 -- mainly to replace the hardcoded `L`
665 cL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
666 cL sp e = composeSrcSpan (L sp e)
667
668 -- | A Pattern Synonym to Set/Get SrcSpans
669 pattern LL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
670 pattern LL sp e <- (dL->L sp e)
671 where
672 LL sp e = cL sp e
673
674 -- | Lifts a function of undecorated entities to one of decorated ones
675 onHasSrcSpan :: (HasSrcSpan a , HasSrcSpan b) =>
676 (SrcSpanLess a -> SrcSpanLess b) -> a -> b
677 onHasSrcSpan f (dL->L l e) = cL l (f e)
678
679 liftL :: (HasSrcSpan a, HasSrcSpan b, Monad m) =>
680 (SrcSpanLess a -> m (SrcSpanLess b)) -> a -> m b
681 liftL f (dL->L loc a) = do
682 a' <- f a
683 return $ cL loc a'
684
685
686 getRealSrcSpan :: RealLocated a -> RealSrcSpan
687 getRealSrcSpan (L l _) = l
688
689 unRealSrcSpan :: RealLocated a -> a
690 unRealSrcSpan (L _ e) = e