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 \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 instance Outputable SrcLoc where
 170     ppr (SrcLoc src_path src_line src_col)
 171       = getPprStyle $ \ sty ->
 172         if userStyle sty || debugStyle sty then
 173             hcat [ pprFastFilePath src_path, char ':',
 174                    int src_line,
 175                    char ':', int src_col
 176                  ]
 177         else
 178             hcat [text "{-# LINE ", int src_line, space,
 179                   char '\"', pprFastFilePath src_path, text " #-}"]
 180
 181     ppr (UnhelpfulLoc s)  = ftext s
 182 \end{code}
 183
 184 %************************************************************************
 185 %*                                                                      *
 186 \subsection[SrcSpan]{Source Spans}
 187 %*                                                                      *
 188 %************************************************************************
 189
 190 \begin{code}
 191 {- |
 192 A SrcSpan delimits a portion of a text file.  It could be represented
 193 by a pair of (line,column) coordinates, but in fact we optimise
 194 slightly by using more compact representations for single-line and
 195 zero-length spans, both of which are quite common.
 196
 197 The end position is defined to be the column /after/ the end of the
 198 span.  That is, a span of (1,1)-(1,2) is one character long, and a
 199 span of (1,1)-(1,1) is zero characters long.
 200 -}
 201 data SrcSpan
 202   = SrcSpanOneLine              -- a common case: a single line
 203         { srcSpanFile     :: !FastString,
 204           srcSpanLine     :: {-# UNPACK #-} !Int,
 205           srcSpanSCol     :: {-# UNPACK #-} !Int,
 206           srcSpanECol     :: {-# UNPACK #-} !Int
 207         }
 208
 209   | SrcSpanMultiLine
 210         { srcSpanFile     :: !FastString,
 211           srcSpanSLine    :: {-# UNPACK #-} !Int,
 212           srcSpanSCol     :: {-# UNPACK #-} !Int,
 213           srcSpanELine    :: {-# UNPACK #-} !Int,
 214           srcSpanECol     :: {-# UNPACK #-} !Int
 215         }
 216
 217   | SrcSpanPoint
 218         { srcSpanFile     :: !FastString,
 219           srcSpanLine     :: {-# UNPACK #-} !Int,
 220           srcSpanCol      :: {-# UNPACK #-} !Int
 221         }
 222
 223   | UnhelpfulSpan !FastString   -- Just a general indication
 224                                 -- also used to indicate an empty span
 225
 226 #ifdef DEBUG
 227   deriving (Eq, Show)   -- Show is used by Lexer.x, becuase we
 228                         -- derive Show for Token
 229 #else
 230   deriving Eq
 231 #endif
 232
 233 -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
 234 noSrcSpan, wiredInSrcSpan :: SrcSpan
 235 noSrcSpan      = UnhelpfulSpan (fsLit "<no location info>")
 236 wiredInSrcSpan = UnhelpfulSpan (fsLit "<wired into compiler>")
 237
 238 -- | Create a "bad" 'SrcSpan' that has not location information
 239 mkGeneralSrcSpan :: FastString -> SrcSpan
 240 mkGeneralSrcSpan = UnhelpfulSpan
 241
 242 -- | Create a 'SrcSpan' corresponding to a single point
 243 srcLocSpan :: SrcLoc -> SrcSpan
 244 srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
 245 srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
 246
 247 -- | Create a 'SrcSpan' between two points in a file
 248 mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
 249 mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
 250 mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
 251 mkSrcSpan loc1 loc2
 252   | line1 == line2 = if col1 == col2
 253                         then SrcSpanPoint file line1 col1
 254                         else SrcSpanOneLine file line1 col1 col2
 255   | otherwise      = SrcSpanMultiLine file line1 col1 line2 col2
 256   where
 257         line1 = srcLocLine loc1
 258         line2 = srcLocLine loc2
 259         col1 = srcLocCol loc1
 260         col2 = srcLocCol loc2
 261         file = srcLocFile loc1
 262
 263 -- | Combines two 'SrcSpan' into one that spans at least all the characters
 264 -- within both spans. Assumes the "file" part is the same in both inputs
 265 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
 266 combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
 267 combineSrcSpans l (UnhelpfulSpan _) = l
 268 combineSrcSpans start end
 269  = case line1 `compare` line2 of
 270      EQ -> case col1 `compare` col2 of
 271                 EQ -> SrcSpanPoint file line1 col1
 272                 LT -> SrcSpanOneLine file line1 col1 col2
 273                 GT -> SrcSpanOneLine file line1 col2 col1
 274      LT -> SrcSpanMultiLine file line1 col1 line2 col2
 275      GT -> SrcSpanMultiLine file line2 col2 line1 col1
 276   where
 277         line1 = srcSpanStartLine start
 278         col1  = srcSpanStartCol start
 279         line2 = srcSpanEndLine end
 280         col2  = srcSpanEndCol end
 281         file  = srcSpanFile start
 282 \end{code}
 283
 284 %************************************************************************
 285 %*                                                                      *
 286 \subsection[SrcSpan-predicates]{Predicates}
 287 %*                                                                      *
 288 %************************************************************************
 289
 290 \begin{code}
 291 -- | Test if a 'SrcSpan' is "good", i.e. has precise location information
 292 isGoodSrcSpan :: SrcSpan -> Bool
 293 isGoodSrcSpan SrcSpanOneLine{} = True
 294 isGoodSrcSpan SrcSpanMultiLine{} = True
 295 isGoodSrcSpan SrcSpanPoint{} = True
 296 isGoodSrcSpan _ = False
 297
 298 isOneLineSpan :: SrcSpan -> Bool
 299 -- ^ True if the span is known to straddle only one line.
 300 -- For "bad" 'SrcSpan', it returns False
 301 isOneLineSpan s
 302   | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s
 303   | otherwise       = False
 304
 305 \end{code}
 306
 307 %************************************************************************
 308 %*                                                                      *
 309 \subsection[SrcSpan-unsafe-access-fns]{Unsafe access functions}
 310 %*                                                                      *
 311 %************************************************************************
 312
 313 \begin{code}
 314
 315 -- | Raises an error when used on a "bad" 'SrcSpan'
 316 srcSpanStartLine :: SrcSpan -> Int
 317 -- | Raises an error when used on a "bad" 'SrcSpan'
 318 srcSpanEndLine :: SrcSpan -> Int
 319 -- | Raises an error when used on a "bad" 'SrcSpan'
 320 srcSpanStartCol :: SrcSpan -> Int
 321 -- | Raises an error when used on a "bad" 'SrcSpan'
 322 srcSpanEndCol :: SrcSpan -> Int
 323
 324 srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
 325 srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
 326 srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
 327 srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine"
 328
 329 srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
 330 srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
 331 srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
 332 srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine"
 333
 334 srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
 335 srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
 336 srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
 337 srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol"
 338
 339 srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
 340 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
 341 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
 342 srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
 343
 344 \end{code}
 345
 346 %************************************************************************
 347 %*                                                                      *
 348 \subsection[SrcSpan-access-fns]{Access functions}
 349 %*                                                                      *
 350 %************************************************************************
 351
 352 \begin{code}
 353
 354 -- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
 355 srcSpanStart :: SrcSpan -> SrcLoc
 356 -- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
 357 srcSpanEnd :: SrcSpan -> SrcLoc
 358
 359 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
 360 srcSpanStart s = mkSrcLoc (srcSpanFile s)
 361                           (srcSpanStartLine s)
 362                           (srcSpanStartCol s)
 363
 364 srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
 365 srcSpanEnd s =
 366   mkSrcLoc (srcSpanFile s)
 367            (srcSpanEndLine s)
 368            (srcSpanEndCol s)
 369
 370 -- | Obtains the filename for a 'SrcSpan' if it is "good"
 371 srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
 372 srcSpanFileName_maybe (SrcSpanOneLine { srcSpanFile = nm })   = Just nm
 373 srcSpanFileName_maybe (SrcSpanMultiLine { srcSpanFile = nm }) = Just nm
 374 srcSpanFileName_maybe (SrcSpanPoint { srcSpanFile = nm})      = Just nm
 375 srcSpanFileName_maybe _                                       = Nothing
 376
 377 \end{code}
 378
 379 %************************************************************************
 380 %*                                                                      *
 381 \subsection[SrcSpan-instances]{Instances}
 382 %*                                                                      *
 383 %************************************************************************
 384
 385 \begin{code}
 386
 387 -- We want to order SrcSpans first by the start point, then by the end point.
 388 instance Ord SrcSpan where
 389   a `compare` b =
 390      (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
 391      (srcSpanEnd   a `compare` srcSpanEnd   b)
 392
 393
 394 instance Outputable SrcSpan where
 395     ppr span
 396       = getPprStyle $ \ sty ->
 397         if userStyle sty || debugStyle sty then
 398            pprUserSpan True span
 399         else
 400            hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
 401                  char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
 402
 403 pprUserSpan :: Bool -> SrcSpan -> SDoc
 404 pprUserSpan show_path (SrcSpanOneLine src_path line start_col end_col)
 405   = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
 406          , int line, char ':', int start_col
 407          , ppUnless (end_col - start_col <= 1)
 408                     (char '-' <> int (end_col-1))
 409             -- For single-character or point spans, we just
 410             -- output the starting column number
 411          ]
 412
 413
 414 pprUserSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
 415   = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
 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 show_path (SrcSpanPoint src_path line col)
 423   = hcat [ ppWhen show_path $ (pprFastFilePath src_path <> colon)
 424          , int line, char ':', int col ]
 425
 426 pprUserSpan _ (UnhelpfulSpan s)  = ftext s
 427
 428 pprDefnLoc :: SrcSpan -> SDoc
 429 -- ^ Pretty prints information about the 'SrcSpan' in the style "defined at ..."
 430 pprDefnLoc loc
 431   | isGoodSrcSpan loc = ptext (sLit "Defined at") <+> ppr loc
 432   | otherwise         = ppr loc
 433 \end{code}
 434
 435 %************************************************************************
 436 %*                                                                      *
 437 \subsection[Located]{Attaching SrcSpans to things}
 438 %*                                                                      *
 439 %************************************************************************
 440
 441 \begin{code}
 442 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
 443 data Located e = L SrcSpan e
 444
 445 unLoc :: Located e -> e
 446 unLoc (L _ e) = e
 447
 448 getLoc :: Located e -> SrcSpan
 449 getLoc (L l _) = l
 450
 451 noLoc :: e -> Located e
 452 noLoc e = L noSrcSpan e
 453
 454 mkGeneralLocated :: String -> e -> Located e
 455 mkGeneralLocated s e = L (mkGeneralSrcSpan (fsLit s)) e
 456
 457 combineLocs :: Located a -> Located b -> SrcSpan
 458 combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
 459
 460 -- | Combine locations from two 'Located' things and add them to a third thing
 461 addCLoc :: Located a -> Located b -> c -> Located c
 462 addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
 463
 464 -- not clear whether to add a general Eq instance, but this is useful sometimes:
 465
 466 -- | Tests whether the two located things are equal
 467 eqLocated :: Eq a => Located a -> Located a -> Bool
 468 eqLocated a b = unLoc a == unLoc b
 469
 470 -- not clear whether to add a general Ord instance, but this is useful sometimes:
 471
 472 -- | Tests the ordering of the two located things
 473 cmpLocated :: Ord a => Located a -> Located a -> Ordering
 474 cmpLocated a b = unLoc a `compare` unLoc b
 475
 476 instance Functor Located where
 477   fmap f (L l e) = L l (f e)
 478
 479 instance Outputable e => Outputable (Located e) where
 480   ppr (L l e) = ifPprDebug (braces (pprUserSpan False l)) <> ppr e
 481                 -- Print spans without the file name etc
 482 \end{code}
 483
 484 %************************************************************************
 485 %*                                                                      *
 486 \subsection{Ordering SrcSpans for InteractiveUI}
 487 %*                                                                      *
 488 %************************************************************************
 489
 490 \begin{code}
 491 -- | Alternative strategies for ordering 'SrcSpan's
 492 leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
 493 rightmost            = flip compare
 494 leftmost_smallest    = compare
 495 leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
 496                                 `thenCmp`
 497                        (srcSpanEnd b `compare` srcSpanEnd a)
 498
 499
 500 -- | Determines whether a span encloses a given line and column index
 501 spans :: SrcSpan -> (Int, Int) -> Bool
 502 spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
 503    where loc = mkSrcLoc (srcSpanFile span) l c
 504
 505 -- | Determines whether a span is enclosed by another one
 506 isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other
 507             -> SrcSpan -- ^ The span it may be enclosed by
 508             -> Bool
 509 isSubspanOf src parent
 510     | srcSpanFileName_maybe parent /= srcSpanFileName_maybe src = False
 511     | otherwise = srcSpanStart parent <= srcSpanStart src &&
 512                   srcSpanEnd parent   >= srcSpanEnd src
 513
 514 \end{code}