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