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   deriving Eq
 190
 191 -- We want to order SrcSpans first by the start point, then by the end point.
 192 instance Ord SrcSpan where
 193   a `compare` b =
 194      (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
 195      (srcSpanEnd   a `compare` srcSpanEnd   b)
 196
 197 noSrcSpan, wiredInSrcSpan :: SrcSpan
 198 noSrcSpan      = UnhelpfulSpan FSLIT("<no location info>")
 199 wiredInSrcSpan = UnhelpfulSpan FSLIT("<wired into compiler>")
 200
 201 mkGeneralSrcSpan :: FastString -> SrcSpan
 202 mkGeneralSrcSpan = UnhelpfulSpan
 203
 204 isGoodSrcSpan :: SrcSpan -> Bool
 205 isGoodSrcSpan SrcSpanOneLine{} = True
 206 isGoodSrcSpan SrcSpanMultiLine{} = True
 207 isGoodSrcSpan SrcSpanPoint{} = True
 208 isGoodSrcSpan _ = False
 209
 210 optSrcSpanFileName :: SrcSpan -> Maybe FastString
 211 optSrcSpanFileName (SrcSpanOneLine { srcSpanFile = nm })   = Just nm
 212 optSrcSpanFileName (SrcSpanMultiLine { srcSpanFile = nm }) = Just nm
 213 optSrcSpanFileName (SrcSpanPoint { srcSpanFile = nm})      = Just nm
 214 optSrcSpanFileName _                                       = Nothing
 215
 216 isOneLineSpan :: SrcSpan -> Bool
 217 -- True if the span is known to straddle more than one line
 218 -- By default, it returns False
 219 isOneLineSpan s
 220   | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s
 221   | otherwise       = False
 222
 223 --------------------------------------------------------
 224 -- Don't export these four;
 225 -- they panic on Unhelpful.
 226 -- They are for internal use only
 227 -- Urk!  Some are needed for Lexer.x; see comment in export list
 228
 229 srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol
 230   :: SrcSpan -> Int
 231
 232 srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
 233 srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
 234 srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
 235 srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine"
 236
 237 srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
 238 srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
 239 srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
 240 srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine"
 241
 242 srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
 243 srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
 244 srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
 245 srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol"
 246
 247 srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
 248 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
 249 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
 250 srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
 251 --------------------------------------------------------
 252
 253 srcSpanStart, srcSpanEnd :: SrcSpan -> SrcLoc
 254
 255 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
 256 srcSpanStart s = mkSrcLoc (srcSpanFile s)
 257                           (srcSpanStartLine s)
 258                           (srcSpanStartCol s)
 259
 260 srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
 261 srcSpanEnd s =
 262   mkSrcLoc (srcSpanFile s)
 263            (srcSpanEndLine s)
 264            (srcSpanEndCol s)
 265
 266 srcLocSpan :: SrcLoc -> SrcSpan
 267 srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
 268 srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
 269
 270 mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
 271 mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
 272 mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
 273 mkSrcSpan loc1 loc2
 274   | line1 == line2 = if col1 == col2
 275                         then SrcSpanPoint file line1 col1
 276                         else SrcSpanOneLine file line1 col1 col2
 277   | otherwise      = SrcSpanMultiLine file line1 col1 line2 col2
 278   where
 279         line1 = srcLocLine loc1
 280         line2 = srcLocLine loc2
 281         col1 = srcLocCol loc1
 282         col2 = srcLocCol loc2
 283         file = srcLocFile loc1
 284
 285 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
 286 -- Assumes the 'file' part is the same in both
 287 combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
 288 combineSrcSpans l (UnhelpfulSpan _) = l
 289 combineSrcSpans start end
 290  = case line1 `compare` line2 of
 291      EQ -> case col1 `compare` col2 of
 292                 EQ -> SrcSpanPoint file line1 col1
 293                 LT -> SrcSpanOneLine file line1 col1 col2
 294                 GT -> SrcSpanOneLine file line1 col2 col1
 295      LT -> SrcSpanMultiLine file line1 col1 line2 col2
 296      GT -> SrcSpanMultiLine file line2 col2 line1 col1
 297   where
 298         line1 = srcSpanStartLine start
 299         col1  = srcSpanStartCol start
 300         line2 = srcSpanEndLine end
 301         col2  = srcSpanEndCol end
 302         file  = srcSpanFile start
 303
 304 pprDefnLoc :: SrcSpan -> SDoc
 305 -- "defined at ..."
 306 pprDefnLoc loc
 307   | isGoodSrcSpan loc = ptext SLIT("Defined at") <+> ppr loc
 308   | otherwise         = ppr loc
 309
 310 instance Outputable SrcSpan where
 311     ppr span
 312       = getPprStyle $ \ sty ->
 313         if userStyle sty || debugStyle sty then
 314            pprUserSpan span
 315         else
 316            hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
 317                  char '\"', ftext (srcSpanFile span), text " #-}"]
 318
 319
 320 pprUserSpan :: SrcSpan -> SDoc
 321 pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
 322   = hcat [ ftext src_path, char ':',
 323            int line,
 324            char ':', int start_col
 325          ]
 326     <> if end_col - start_col <= 1
 327           then empty
 328             -- for single-character or point spans, we just output the starting
 329             -- column number
 330           else  char '-' <> int (end_col-1)
 331
 332 pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
 333   = hcat [ ftext src_path, char ':',
 334                   parens (int sline <> char ',' <>  int scol),
 335                   char '-',
 336                   parens (int eline <> char ',' <>
 337                            if ecol == 0 then int ecol else int (ecol-1))
 338                 ]
 339
 340 pprUserSpan (SrcSpanPoint src_path line col)
 341   = hcat [ ftext src_path, char ':',
 342            int line,
 343            char ':', int col
 344          ]
 345
 346 pprUserSpan (UnhelpfulSpan s)  = ftext s
 347 \end{code}
 348
 349 %************************************************************************
 350 %*                                                                      *
 351 \subsection[Located]{Attaching SrcSpans to things}
 352 %*                                                                      *
 353 %************************************************************************
 354
 355 \begin{code}
 356 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
 357 data Located e = L SrcSpan e
 358
 359 unLoc :: Located e -> e
 360 unLoc (L _ e) = e
 361
 362 getLoc :: Located e -> SrcSpan
 363 getLoc (L l _) = l
 364
 365 noLoc :: e -> Located e
 366 noLoc e = L noSrcSpan e
 367
 368 combineLocs :: Located a -> Located b -> SrcSpan
 369 combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
 370
 371 addCLoc :: Located a -> Located b -> c -> Located c
 372 addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
 373
 374 -- not clear whether to add a general Eq instance, but this is useful sometimes:
 375 eqLocated :: Eq a => Located a -> Located a -> Bool
 376 eqLocated a b = unLoc a == unLoc b
 377
 378 -- not clear whether to add a general Eq instance, but this is useful sometimes:
 379 cmpLocated :: Ord a => Located a -> Located a -> Ordering
 380 cmpLocated a b = unLoc a `compare` unLoc b
 381
 382 instance Functor Located where
 383   fmap f (L l e) = L l (f e)
 384
 385 instance Outputable e => Outputable (Located e) where
 386   ppr (L _ e) =  ppr e
 387         -- do we want to dump the span in debugSty mode?
 388 \end{code}
 389
 390
 391 %************************************************************************
 392 %*                                                                      *
 393 \subsection{Manipulating SrcSpans}
 394 %*                                                                      *
 395 %************************************************************************
 396
 397 \begin{code}
 398 leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
 399 rightmost            = flip compare
 400 leftmost_smallest    = compare
 401 leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
 402                                 `thenCmp`
 403                        (srcSpanEnd b `compare` srcSpanEnd a)
 404
 405
 406 spans :: SrcSpan -> (Int,Int) -> Bool
 407 spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
 408    where loc = mkSrcLoc (srcSpanFile span) l c
 409
 410 isSubspanOf :: SrcSpan -> SrcSpan -> Bool
 411 isSubspanOf src parent
 412     | optSrcSpanFileName parent /= optSrcSpanFileName src = False
 413     | otherwise = srcSpanStart parent <= srcSpanStart src &&
 414                   srcSpanEnd parent   >= srcSpanEnd src
 415
 416 \end{code}