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