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