compiler/basicTypes/SrcLoc.lhs

   1 %
   2 % (c) The University of Glasgow, 1992-2006
   3 %
   4
   5 \begin{code}
   6 module SrcLoc (
   7         SrcLoc,                 -- Abstract
   8
   9         mkSrcLoc, isGoodSrcLoc, mkGeneralSrcLoc,
  10         noSrcLoc,               -- "I'm sorry, I haven't a clue"
  11         advanceSrcLoc,
  12
  13         generatedSrcLoc,        -- Code generated within the compiler
  14         interactiveSrcLoc,      -- Code from an interactive session
  15
  16         srcLocFile,             -- return the file name part
  17         srcLocLine,             -- return the line part
  18         srcLocCol,              -- return the column part
  19         pprDefnLoc,
  20
  21         SrcSpan,                -- Abstract
  22         noSrcSpan,
  23         wiredInSrcSpan,         -- Something wired into the compiler
  24         mkGeneralSrcSpan,
  25         isGoodSrcSpan, isOneLineSpan,
  26         mkSrcSpan, srcLocSpan,
  27         combineSrcSpans,
  28         srcSpanStart, srcSpanEnd,
  29         optSrcSpanFileName,
  30
  31         -- These are dubious exports, because they crash on some inputs,
  32         -- used only in Lexer.x where we are sure what the Span looks like
  33         srcSpanFile,
  34         srcSpanStartLine, srcSpanEndLine,
  35         srcSpanStartCol, srcSpanEndCol,
  36
  37         Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc,
  38         leftmost_smallest, leftmost_largest, rightmost, spans, isSubspanOf
  39     ) where
  40
  41 #include "HsVersions.h"
  42
  43 import Util
  44 import Outputable
  45 import FastString
  46 \end{code}
  47
  48 %************************************************************************
  49 %*                                                                      *
  50 \subsection[SrcLoc-SrcLocations]{Source-location information}
  51 %*                                                                      *
  52 %************************************************************************
  53
  54 We keep information about the {\em definition} point for each entity;
  55 this is the obvious stuff:
  56 \begin{code}
  57 data SrcLoc
  58   = SrcLoc      FastString      -- A precise location (file name)
  59                 !Int            -- line number, begins at 1
  60                 !Int            -- column number, begins at 0
  61                 -- Don't ask me why lines start at 1 and columns start at
  62                 -- zero.  That's just the way it is, so there.  --SDM
  63
  64   | UnhelpfulLoc FastString     -- Just a general indication
  65 \end{code}
  66
  67 %************************************************************************
  68 %*                                                                      *
  69 \subsection[SrcLoc-access-fns]{Access functions for names}
  70 %*                                                                      *
  71 %************************************************************************
  72
  73 Things to make 'em:
  74 \begin{code}
  75 mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
  76 mkSrcLoc x line col = SrcLoc x line col
  77
  78 noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
  79 noSrcLoc          = UnhelpfulLoc FSLIT("<no location info>")
  80 generatedSrcLoc   = UnhelpfulLoc FSLIT("<compiler-generated code>")
  81 interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
  82
  83 mkGeneralSrcLoc :: FastString -> SrcLoc
  84 mkGeneralSrcLoc = UnhelpfulLoc
  85
  86 isGoodSrcLoc :: SrcLoc -> Bool
  87 isGoodSrcLoc (SrcLoc _ _ _) = True
  88 isGoodSrcLoc _other         = False
  89
  90 srcLocFile :: SrcLoc -> FastString
  91 srcLocFile (SrcLoc fname _ _) = fname
  92 srcLocFile _other             = FSLIT("<unknown file")
  93
  94 srcLocLine :: SrcLoc -> Int
  95 srcLocLine (SrcLoc _ l _) = l
  96 srcLocLine _other         = panic "srcLocLine: unknown line"
  97
  98 srcLocCol :: SrcLoc -> Int
  99 srcLocCol (SrcLoc _ _ c) = c
 100 srcLocCol _other         = panic "srcLocCol: unknown col"
 101
 102 advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
 103 advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f  (l + 1) 0
 104 advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
 105 advanceSrcLoc loc            _    = loc -- Better than nothing
 106 \end{code}
 107
 108 %************************************************************************
 109 %*                                                                      *
 110 \subsection[SrcLoc-instances]{Instance declarations for various names}
 111 %*                                                                      *
 112 %************************************************************************
 113
 114 \begin{code}
 115 -- SrcLoc is an instance of Ord so that we can sort error messages easily
 116 instance Eq SrcLoc where
 117   loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
 118                    EQ     -> True
 119                    _other -> False
 120
 121 instance Ord SrcLoc where
 122   compare = cmpSrcLoc
 123
 124 cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering
 125 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
 126 cmpSrcLoc (UnhelpfulLoc _)  _other            = LT
 127
 128 cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
 129   = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
 130 cmpSrcLoc (SrcLoc _ _ _) _other = GT
 131
 132 instance Outputable SrcLoc where
 133     ppr (SrcLoc src_path src_line src_col)
 134       = getPprStyle $ \ sty ->
 135         if userStyle sty || debugStyle sty then
 136            hcat [ ftext src_path, char ':',
 137                   int src_line,
 138                   char ':', int src_col
 139                 ]
 140         else
 141            hcat [text "{-# LINE ", int src_line, space,
 142                  char '\"', ftext src_path, text " #-}"]
 143
 144     ppr (UnhelpfulLoc s)  = ftext s
 145 \end{code}
 146
 147 %************************************************************************
 148 %*                                                                      *
 149 \subsection[SrcSpan]{Source Spans}
 150 %*                                                                      *
 151 %************************************************************************
 152
 153 \begin{code}
 154 {- |
 155 A SrcSpan delimits a portion of a text file.  It could be represented
 156 by a pair of (line,column) coordinates, but in fact we optimise
 157 slightly by using more compact representations for single-line and
 158 zero-length spans, both of which are quite common.
 159
 160 The end position is defined to be the column *after* the end of the
 161 span.  That is, a span of (1,1)-(1,2) is one character long, and a
 162 span of (1,1)-(1,1) is zero characters long.
 163 -}
 164 data SrcSpan
 165   = SrcSpanOneLine              -- a common case: a single line
 166         { srcSpanFile     :: FastString,
 167           srcSpanLine     :: !Int,
 168           srcSpanSCol     :: !Int,
 169           srcSpanECol     :: !Int
 170         }
 171
 172   | SrcSpanMultiLine
 173         { srcSpanFile     :: FastString,
 174           srcSpanSLine    :: !Int,
 175           srcSpanSCol     :: !Int,
 176           srcSpanELine    :: !Int,
 177           srcSpanECol     :: !Int
 178         }
 179
 180   | SrcSpanPoint
 181         { srcSpanFile     :: FastString,
 182           srcSpanLine     :: !Int,
 183           srcSpanCol      :: !Int
 184         }
 185
 186   | UnhelpfulSpan FastString    -- Just a general indication
 187                                 -- also used to indicate an empty span
 188
 189 #ifdef DEBUG
 190   deriving (Eq, Show)   -- Show is used by Lexer.x, becuase we
 191                         -- derive Show for Token
 192 #else
 193   deriving Eq
 194 #endif
 195
 196 -- We want to order SrcSpans first by the start point, then by the end point.
 197 instance Ord SrcSpan where
 198   a `compare` b =
 199      (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
 200      (srcSpanEnd   a `compare` srcSpanEnd   b)
 201
 202 noSrcSpan, wiredInSrcSpan :: SrcSpan
 203 noSrcSpan      = UnhelpfulSpan FSLIT("<no location info>")
 204 wiredInSrcSpan = UnhelpfulSpan FSLIT("<wired into compiler>")
 205
 206 mkGeneralSrcSpan :: FastString -> SrcSpan
 207 mkGeneralSrcSpan = UnhelpfulSpan
 208
 209 isGoodSrcSpan :: SrcSpan -> Bool
 210 isGoodSrcSpan SrcSpanOneLine{} = True
 211 isGoodSrcSpan SrcSpanMultiLine{} = True
 212 isGoodSrcSpan SrcSpanPoint{} = True
 213 isGoodSrcSpan _ = False
 214
 215 optSrcSpanFileName :: SrcSpan -> Maybe FastString
 216 optSrcSpanFileName (SrcSpanOneLine { srcSpanFile = nm })   = Just nm
 217 optSrcSpanFileName (SrcSpanMultiLine { srcSpanFile = nm }) = Just nm
 218 optSrcSpanFileName (SrcSpanPoint { srcSpanFile = nm})      = Just nm
 219 optSrcSpanFileName _                                       = Nothing
 220
 221 isOneLineSpan :: SrcSpan -> Bool
 222 -- True if the span is known to straddle more than one line
 223 -- By default, it returns False
 224 isOneLineSpan s
 225   | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s
 226   | otherwise       = False
 227
 228 --------------------------------------------------------
 229 -- Don't export these four;
 230 -- they panic on Unhelpful.
 231 -- They are for internal use only
 232 -- Urk!  Some are needed for Lexer.x; see comment in export list
 233
 234 srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol
 235   :: SrcSpan -> Int
 236
 237 srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
 238 srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
 239 srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
 240 srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine"
 241
 242 srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
 243 srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
 244 srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
 245 srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine"
 246
 247 srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
 248 srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
 249 srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
 250 srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol"
 251
 252 srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
 253 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
 254 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
 255 srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
 256 --------------------------------------------------------
 257
 258 srcSpanStart, srcSpanEnd :: SrcSpan -> SrcLoc
 259
 260 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
 261 srcSpanStart s = mkSrcLoc (srcSpanFile s)
 262                           (srcSpanStartLine s)
 263                           (srcSpanStartCol s)
 264
 265 srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
 266 srcSpanEnd s =
 267   mkSrcLoc (srcSpanFile s)
 268            (srcSpanEndLine s)
 269            (srcSpanEndCol s)
 270
 271 srcLocSpan :: SrcLoc -> SrcSpan
 272 srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
 273 srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
 274
 275 mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
 276 mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
 277 mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
 278 mkSrcSpan loc1 loc2
 279   | line1 == line2 = if col1 == col2
 280                         then SrcSpanPoint file line1 col1
 281                         else SrcSpanOneLine file line1 col1 col2
 282   | otherwise      = SrcSpanMultiLine file line1 col1 line2 col2
 283   where
 284         line1 = srcLocLine loc1
 285         line2 = srcLocLine loc2
 286         col1 = srcLocCol loc1
 287         col2 = srcLocCol loc2
 288         file = srcLocFile loc1
 289
 290 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
 291 -- Assumes the 'file' part is the same in both
 292 combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
 293 combineSrcSpans l (UnhelpfulSpan _) = l
 294 combineSrcSpans start end
 295  = case line1 `compare` line2 of
 296      EQ -> case col1 `compare` col2 of
 297                 EQ -> SrcSpanPoint file line1 col1
 298                 LT -> SrcSpanOneLine file line1 col1 col2
 299                 GT -> SrcSpanOneLine file line1 col2 col1
 300      LT -> SrcSpanMultiLine file line1 col1 line2 col2
 301      GT -> SrcSpanMultiLine file line2 col2 line1 col1
 302   where
 303         line1 = srcSpanStartLine start
 304         col1  = srcSpanStartCol start
 305         line2 = srcSpanEndLine end
 306         col2  = srcSpanEndCol end
 307         file  = srcSpanFile start
 308
 309 pprDefnLoc :: SrcSpan -> SDoc
 310 -- "defined at ..."
 311 pprDefnLoc loc
 312   | isGoodSrcSpan loc = ptext SLIT("Defined at") <+> ppr loc
 313   | otherwise         = ppr loc
 314
 315 instance Outputable SrcSpan where
 316     ppr span
 317       = getPprStyle $ \ sty ->
 318         if userStyle sty || debugStyle sty then
 319            pprUserSpan span
 320         else
 321            hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
 322                  char '\"', ftext (srcSpanFile span), text " #-}"]
 323
 324
 325 pprUserSpan :: SrcSpan -> SDoc
 326 pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
 327   = hcat [ ftext src_path, char ':',
 328            int line,
 329            char ':', int start_col
 330          ]
 331     <> if end_col - start_col <= 1
 332           then empty
 333             -- for single-character or point spans, we just output the starting
 334             -- column number
 335           else  char '-' <> int (end_col-1)
 336
 337 pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
 338   = hcat [ ftext src_path, char ':',
 339                   parens (int sline <> char ',' <>  int scol),
 340                   char '-',
 341                   parens (int eline <> char ',' <>
 342                            if ecol == 0 then int ecol else int (ecol-1))
 343                 ]
 344
 345 pprUserSpan (SrcSpanPoint src_path line col)
 346   = hcat [ ftext src_path, char ':',
 347            int line,
 348            char ':', int col
 349          ]
 350
 351 pprUserSpan (UnhelpfulSpan s)  = ftext s
 352 \end{code}
 353
 354 %************************************************************************
 355 %*                                                                      *
 356 \subsection[Located]{Attaching SrcSpans to things}
 357 %*                                                                      *
 358 %************************************************************************
 359
 360 \begin{code}
 361 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
 362 data Located e = L SrcSpan e
 363
 364 unLoc :: Located e -> e
 365 unLoc (L _ e) = e
 366
 367 getLoc :: Located e -> SrcSpan
 368 getLoc (L l _) = l
 369
 370 noLoc :: e -> Located e
 371 noLoc e = L noSrcSpan e
 372
 373 combineLocs :: Located a -> Located b -> SrcSpan
 374 combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
 375
 376 addCLoc :: Located a -> Located b -> c -> Located c
 377 addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
 378
 379 -- not clear whether to add a general Eq instance, but this is useful sometimes:
 380 eqLocated :: Eq a => Located a -> Located a -> Bool
 381 eqLocated a b = unLoc a == unLoc b
 382
 383 -- not clear whether to add a general Eq instance, but this is useful sometimes:
 384 cmpLocated :: Ord a => Located a -> Located a -> Ordering
 385 cmpLocated a b = unLoc a `compare` unLoc b
 386
 387 instance Functor Located where
 388   fmap f (L l e) = L l (f e)
 389
 390 instance Outputable e => Outputable (Located e) where
 391   ppr (L _ e) =  ppr e
 392         -- do we want to dump the span in debugSty mode?
 393 \end{code}
 394
 395
 396 %************************************************************************
 397 %*                                                                      *
 398 \subsection{Manipulating SrcSpans}
 399 %*                                                                      *
 400 %************************************************************************
 401
 402 \begin{code}
 403 leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
 404 rightmost            = flip compare
 405 leftmost_smallest    = compare
 406 leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
 407                                 `thenCmp`
 408                        (srcSpanEnd b `compare` srcSpanEnd a)
 409
 410
 411 spans :: SrcSpan -> (Int,Int) -> Bool
 412 spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
 413    where loc = mkSrcLoc (srcSpanFile span) l c
 414
 415 isSubspanOf :: SrcSpan -> SrcSpan -> Bool
 416 isSubspanOf src parent
 417     | optSrcSpanFileName parent /= optSrcSpanFileName src = False
 418     | otherwise = srcSpanStart parent <= srcSpanStart src &&
 419                   srcSpanEnd parent   >= srcSpanEnd src
 420
 421 \end{code}