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