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