compiler/basicTypes/SrcLoc.lhs

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