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