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