compiler/basicTypes/SrcLoc.lhs

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