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
  32         -- These are dubious exports, because they crash on some inputs,
  33         -- used only in Lexer.x where we are sure what the Span looks like
  34         srcSpanFile,
  35         srcSpanStartLine, srcSpanEndLine,
  36         srcSpanStartCol, srcSpanEndCol,
  37
  38         Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc
  39     ) where
  40
  41 #include "HsVersions.h"
  42
  43 import Util
  44 import Outputable
  45 import FastString
  46 \end{code}
  47
  48 %************************************************************************
  49 %*                                                                      *
  50 \subsection[SrcLoc-SrcLocations]{Source-location information}
  51 %*                                                                      *
  52 %************************************************************************
  53
  54 We keep information about the {\em definition} point for each entity;
  55 this is the obvious stuff:
  56 \begin{code}
  57 data SrcLoc
  58   = SrcLoc      FastString      -- A precise location (file name)
  59                 !Int            -- line number, begins at 1
  60                 !Int            -- column number, begins at 0
  61                 -- Don't ask me why lines start at 1 and columns start at
  62                 -- zero.  That's just the way it is, so there.  --SDM
  63
  64   | ImportedLoc FastString      -- Module name
  65
  66   | UnhelpfulLoc FastString     -- Just a general indication
  67 \end{code}
  68
  69 Note that an entity might be imported via more than one route, and
  70 there could be more than one ``definition point'' --- in two or more
  71 \tr{.hi} files.  We deemed it probably-unworthwhile to cater for this
  72 rare case.
  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 importedSrcLoc :: FastString -> SrcLoc
  91 importedSrcLoc mod_name = ImportedLoc mod_name
  92
  93 isGoodSrcLoc (SrcLoc _ _ _) = True
  94 isGoodSrcLoc other          = False
  95
  96 srcLocFile :: SrcLoc -> FastString
  97 srcLocFile (SrcLoc fname _ _) = fname
  98 srcLocFile other              = FSLIT("<unknown file")
  99
 100 srcLocLine :: SrcLoc -> Int
 101 srcLocLine (SrcLoc _ l c) = l
 102 srcLocLine other          = panic "srcLocLine: unknown line"
 103
 104 srcLocCol :: SrcLoc -> Int
 105 srcLocCol (SrcLoc _ l c) = c
 106 srcLocCol other   = panic "srcLocCol: unknown col"
 107
 108 advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
 109 advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f  (l + 1) 0
 110 advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
 111 advanceSrcLoc loc            _    = loc -- Better than nothing
 112 \end{code}
 113
 114 %************************************************************************
 115 %*                                                                      *
 116 \subsection[SrcLoc-instances]{Instance declarations for various names}
 117 %*                                                                      *
 118 %************************************************************************
 119
 120 \begin{code}
 121 -- SrcLoc is an instance of Ord so that we can sort error messages easily
 122 instance Eq SrcLoc where
 123   loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
 124                    EQ    -> True
 125                    other -> False
 126
 127 instance Ord SrcLoc where
 128   compare = cmpSrcLoc
 129
 130 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
 131 cmpSrcLoc (UnhelpfulLoc _)  other             = LT
 132
 133 cmpSrcLoc (ImportedLoc _)  (UnhelpfulLoc _)  = GT
 134 cmpSrcLoc (ImportedLoc m1) (ImportedLoc m2)  = m1 `compare` m2
 135 cmpSrcLoc (ImportedLoc _)  other             = LT
 136
 137 cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
 138   = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
 139 cmpSrcLoc (SrcLoc _ _ _) other = GT
 140
 141 instance Outputable SrcLoc where
 142     ppr (SrcLoc src_path src_line src_col)
 143       = getPprStyle $ \ sty ->
 144         if userStyle sty || debugStyle sty then
 145            hcat [ ftext src_path, char ':',
 146                   int src_line,
 147                   char ':', int src_col
 148                 ]
 149         else
 150            hcat [text "{-# LINE ", int src_line, space,
 151                  char '\"', ftext src_path, text " #-}"]
 152
 153     ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> ftext mod
 154     ppr (UnhelpfulLoc s)  = ftext s
 155 \end{code}
 156
 157 %************************************************************************
 158 %*                                                                      *
 159 \subsection[SrcSpan]{Source Spans}
 160 %*                                                                      *
 161 %************************************************************************
 162
 163 \begin{code}
 164 {- |
 165 A SrcSpan delimits a portion of a text file.  It could be represented
 166 by a pair of (line,column) coordinates, but in fact we optimise
 167 slightly by using more compact representations for single-line and
 168 zero-length spans, both of which are quite common.
 169
 170 The end position is defined to be the column *after* the end of the
 171 span.  That is, a span of (1,1)-(1,2) is one character long, and a
 172 span of (1,1)-(1,1) is zero characters long.
 173 -}
 174 data SrcSpan
 175   = SrcSpanOneLine              -- a common case: a single line
 176         { srcSpanFile     :: FastString,
 177           srcSpanLine     :: !Int,
 178           srcSpanSCol     :: !Int,
 179           srcSpanECol     :: !Int
 180         }
 181
 182   | SrcSpanMultiLine
 183         { srcSpanFile     :: FastString,
 184           srcSpanSLine    :: !Int,
 185           srcSpanSCol     :: !Int,
 186           srcSpanELine    :: !Int,
 187           srcSpanECol     :: !Int
 188         }
 189
 190   | SrcSpanPoint
 191         { srcSpanFile     :: FastString,
 192           srcSpanLine     :: !Int,
 193           srcSpanCol      :: !Int
 194         }
 195
 196   | ImportedSpan FastString     -- Module name
 197
 198   | UnhelpfulSpan FastString    -- Just a general indication
 199                                 -- also used to indicate an empty span
 200
 201   deriving Eq
 202
 203 -- We want to order SrcSpans first by the start point, then by the end point.
 204 instance Ord SrcSpan where
 205   a `compare` b =
 206      (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
 207      (srcSpanEnd   a `compare` srcSpanEnd   b)
 208
 209 noSrcSpan      = UnhelpfulSpan FSLIT("<no location info>")
 210 wiredInSrcSpan = UnhelpfulSpan FSLIT("<wired into compiler>")
 211 importedSrcSpan = ImportedSpan
 212
 213 mkGeneralSrcSpan :: FastString -> SrcSpan
 214 mkGeneralSrcSpan = UnhelpfulSpan
 215
 216 isGoodSrcSpan SrcSpanOneLine{} = True
 217 isGoodSrcSpan SrcSpanMultiLine{} = True
 218 isGoodSrcSpan SrcSpanPoint{} = True
 219 isGoodSrcSpan _ = False
 220
 221 isOneLineSpan :: SrcSpan -> Bool
 222 -- True if the span is known to straddle more than one line
 223 -- By default, it returns False
 224 isOneLineSpan s
 225   | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s
 226   | otherwise       = False
 227
 228 --------------------------------------------------------
 229 -- Don't export these four;
 230 -- they panic on Imported, Unhelpful.
 231 -- They are for internal use only
 232 -- Urk!  Some are needed for Lexer.x; see comment in export list
 233
 234 srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
 235 srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
 236 srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
 237 srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine"
 238
 239 srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
 240 srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
 241 srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
 242 srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine"
 243
 244 srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
 245 srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
 246 srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
 247 srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol"
 248
 249 srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
 250 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
 251 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
 252 srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
 253 --------------------------------------------------------
 254
 255 srcSpanStart (ImportedSpan str) = ImportedLoc str
 256 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
 257 srcSpanStart s = mkSrcLoc (srcSpanFile s)
 258                           (srcSpanStartLine s)
 259                           (srcSpanStartCol s)
 260
 261 srcSpanEnd (ImportedSpan str) = ImportedLoc str
 262 srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
 263 srcSpanEnd s =
 264   mkSrcLoc (srcSpanFile s)
 265            (srcSpanEndLine s)
 266            (srcSpanEndCol s)
 267
 268 srcLocSpan :: SrcLoc -> SrcSpan
 269 srcLocSpan (ImportedLoc str)  = ImportedSpan str
 270 srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
 271 srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
 272
 273 mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
 274 mkSrcSpan (ImportedLoc str) _  = ImportedSpan str
 275 mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
 276 mkSrcSpan _ (ImportedLoc str)  = ImportedSpan str
 277 mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
 278 mkSrcSpan loc1 loc2
 279   | line1 == line2 = if col1 == col2
 280                         then SrcSpanPoint file line1 col1
 281                         else SrcSpanOneLine file line1 col1 col2
 282   | otherwise      = SrcSpanMultiLine file line1 col1 line2 col2
 283   where
 284         line1 = srcLocLine loc1
 285         line2 = srcLocLine loc2
 286         col1 = srcLocCol loc1
 287         col2 = srcLocCol loc2
 288         file = srcLocFile loc1
 289
 290 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
 291 -- Assumes the 'file' part is the same in both
 292 combineSrcSpans (ImportedSpan str) _  = ImportedSpan str
 293 combineSrcSpans (UnhelpfulSpan str) r = r -- this seems more useful
 294 combineSrcSpans _ (ImportedSpan str)  = ImportedSpan str
 295 combineSrcSpans l (UnhelpfulSpan str) = 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 ..." or "imported from ..."
 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 '\"', ftext (srcSpanFile span), text " #-}"]
 325
 326
 327 pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
 328   = hcat [ ftext src_path, char ':',
 329            int line,
 330            char ':', int start_col
 331          ]
 332     <> if end_col - start_col <= 1
 333           then empty
 334             -- for single-character or point spans, we just output the starting
 335             -- column number
 336           else  char '-' <> int (end_col-1)
 337
 338 pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
 339   = hcat [ ftext src_path, char ':',
 340                   parens (int sline <> char ',' <>  int scol),
 341                   char '-',
 342                   parens (int eline <> char ',' <>
 343                            if ecol == 0 then int ecol else int (ecol-1))
 344                 ]
 345
 346 pprUserSpan (SrcSpanPoint src_path line col)
 347   = hcat [ ftext src_path, char ':',
 348            int line,
 349            char ':', int col
 350          ]
 351
 352 pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> ftext mod
 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 span e) =  ppr e
 394         -- do we want to dump the span in debugSty mode?
 395 \end{code}