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