ghc/compiler/basicTypes/SrcLoc.lhs

   1 %
   2 % (c) The University of Glasgow, 1992-2003
   3 %
   4 %************************************************************************
   5 %*                                                                      *
   6 \section[SrcLoc]{The @SrcLoc@ type}
   7 %*                                                                      *
   8 %************************************************************************
   9
  10 \begin{code}
  11 module SrcLoc (
  12         SrcLoc,                 -- Abstract
  13
  14         mkSrcLoc, isGoodSrcLoc, mkGeneralSrcLoc,
  15         noSrcLoc,               -- "I'm sorry, I haven't a clue"
  16         advanceSrcLoc,
  17
  18         importedSrcLoc,         -- Unknown place in an interface
  19         wiredInSrcLoc,          -- Something wired into the compiler
  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
  27
  28         SrcSpan,                -- Abstract
  29         noSrcSpan,
  30         mkGeneralSrcSpan,
  31         isGoodSrcSpan,
  32         mkSrcSpan, srcLocSpan,
  33         combineSrcSpans,
  34         srcSpanFile,
  35         srcSpanStartLine, srcSpanEndLine,
  36         srcSpanStartCol, srcSpanEndCol,
  37         srcSpanStart, srcSpanEnd,
  38
  39         Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc
  40     ) where
  41
  42 #include "HsVersions.h"
  43
  44 import Util             ( thenCmp )
  45 import Outputable
  46 import FastString
  47 \end{code}
  48
  49 %************************************************************************
  50 %*                                                                      *
  51 \subsection[SrcLoc-SrcLocations]{Source-location information}
  52 %*                                                                      *
  53 %************************************************************************
  54
  55 We keep information about the {\em definition} point for each entity;
  56 this is the obvious stuff:
  57 \begin{code}
  58 data SrcLoc
  59   = SrcLoc      FastString      -- A precise location (file name)
  60                 !Int            -- line number, begins at 1
  61                 !Int            -- column number, begins at 0
  62                 -- Don't ask me why lines start at 1 and columns start at
  63                 -- zero.  That's just the way it is, so there.  --SDM
  64
  65   | ImportedLoc String          -- Module name
  66
  67   | UnhelpfulLoc FastString     -- Just a general indication
  68
  69 {-
  70 data SrcSpan
  71   = WiredInSpan
  72
  73         -- A precise source file span
  74   | SrcSpan     FastString      -- file name
  75                 FastInt         -- beginning line
  76                 FastInt         -- beginning column
  77                 FastInt         -- end line
  78                 FastInt         -- end column
  79
  80   | UnhelpfulSrcSpan FastString -- Just a general indication
  81 -}
  82 \end{code}
  83
  84 Note that an entity might be imported via more than one route, and
  85 there could be more than one ``definition point'' --- in two or more
  86 \tr{.hi} files.  We deemed it probably-unworthwhile to cater for this
  87 rare case.
  88
  89 %************************************************************************
  90 %*                                                                      *
  91 \subsection[SrcLoc-access-fns]{Access functions for names}
  92 %*                                                                      *
  93 %************************************************************************
  94
  95 Things to make 'em:
  96 \begin{code}
  97 mkSrcLoc x line col = SrcLoc x line col
  98 noSrcLoc          = UnhelpfulLoc FSLIT("<no location info>")
  99 generatedSrcLoc   = UnhelpfulLoc FSLIT("<compiler-generated code>")
 100 wiredInSrcLoc     = UnhelpfulLoc FSLIT("<wired into compiler>")
 101 interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
 102
 103 mkGeneralSrcLoc :: FastString -> SrcLoc
 104 mkGeneralSrcLoc = UnhelpfulLoc
 105
 106 importedSrcLoc :: String -> SrcLoc
 107 importedSrcLoc mod_name = ImportedLoc mod_name
 108
 109 isGoodSrcLoc (SrcLoc _ _ _) = True
 110 isGoodSrcLoc other          = False
 111
 112 srcLocFile :: SrcLoc -> FastString
 113 srcLocFile (SrcLoc fname _ _) = fname
 114 srcLocFile other              = FSLIT("<unknown file")
 115
 116 srcLocLine :: SrcLoc -> Int
 117 srcLocLine (SrcLoc _ l c) = l
 118 srcLocLine other          = panic "srcLocLine: unknown line"
 119
 120 srcLocCol :: SrcLoc -> Int
 121 srcLocCol (SrcLoc _ l c) = c
 122 srcLocCol other   = panic "srcLocCol: unknown col"
 123
 124 advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
 125 advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f  l (tab c)
 126 advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f  (l + 1) 0
 127 advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
 128 advanceSrcLoc loc            _    = loc -- Better than nothing
 129
 130 -- Advance to the next tab stop.  Tabs are at column positions 0, 8, 16, etc.
 131 tab :: Int -> Int
 132 tab c = (c `quot` 8 + 1) * 8
 133 \end{code}
 134
 135 %************************************************************************
 136 %*                                                                      *
 137 \subsection[SrcLoc-instances]{Instance declarations for various names}
 138 %*                                                                      *
 139 %************************************************************************
 140
 141 \begin{code}
 142 -- SrcLoc is an instance of Ord so that we can sort error messages easily
 143 instance Eq SrcLoc where
 144   loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
 145                    EQ    -> True
 146                    other -> False
 147
 148 instance Ord SrcLoc where
 149   compare = cmpSrcLoc
 150
 151 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
 152 cmpSrcLoc (UnhelpfulLoc _)  other             = LT
 153
 154 cmpSrcLoc (ImportedLoc _)  (UnhelpfulLoc _)  = GT
 155 cmpSrcLoc (ImportedLoc m1) (ImportedLoc m2)  = m1 `compare` m2
 156 cmpSrcLoc (ImportedLoc _)  other             = LT
 157
 158 cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
 159   = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) `thenCmp` (c1 `cmpline` c2)
 160   where
 161         l1 `cmpline` l2 | l1 <  l2 = LT
 162                         | l1 == l2 = EQ
 163                         | otherwise = GT
 164 cmpSrcLoc (SrcLoc _ _ _) other = GT
 165
 166 instance Outputable SrcLoc where
 167     ppr (SrcLoc src_path src_line src_col)
 168       = getPprStyle $ \ sty ->
 169         if userStyle sty || debugStyle sty then
 170            hcat [ ftext src_path, char ':',
 171                   int src_line,
 172                   char ':', int src_col
 173                 ]
 174         else
 175            hcat [text "{-# LINE ", int src_line, space,
 176                  char '\"', ftext src_path, text " #-}"]
 177
 178     ppr (ImportedLoc mod) = ptext SLIT("Imported from") <+> quotes (text mod)
 179     ppr (UnhelpfulLoc s)  = ftext s
 180 \end{code}
 181
 182 %************************************************************************
 183 %*                                                                      *
 184 \subsection[SrcSpan]{Source Spans}
 185 %*                                                                      *
 186 %************************************************************************
 187
 188 \begin{code}
 189 {- |
 190 A SrcSpan delimits a portion of a text file.  It could be represented
 191 by a pair of (line,column) coordinates, but in fact we optimise
 192 slightly by using more compact representations for single-line and
 193 zero-length spans, both of which are quite common.
 194
 195 The end position is defined to be the column *after* the end of the
 196 span.  That is, a span of (1,1)-(1,2) is one character long, and a
 197 span of (1,1)-(1,1) is zero characters long.
 198 -}
 199 data SrcSpan
 200   = SrcSpanOneLine              -- a common case: a single line
 201         { srcSpanFile     :: FastString,
 202           srcSpanLine     :: !Int,
 203           srcSpanSCol     :: !Int,
 204           srcSpanECol     :: !Int
 205         }
 206
 207   | SrcSpanMultiLine
 208         { srcSpanFile     :: FastString,
 209           srcSpanSLine    :: !Int,
 210           srcSpanSCol     :: !Int,
 211           srcSpanELine    :: !Int,
 212           srcSpanECol     :: !Int
 213         }
 214
 215   | SrcSpanPoint
 216         { srcSpanFile     :: FastString,
 217           srcSpanLine     :: !Int,
 218           srcSpanCol      :: !Int
 219         }
 220
 221   | ImportedSpan String         -- Module name
 222
 223   | UnhelpfulSpan FastString    -- Just a general indication
 224                                 -- also used to indicate an empty span
 225
 226   deriving Eq
 227
 228 -- We want to order SrcSpans first by the start point, then by the end point.
 229 instance Ord SrcSpan where
 230   a `compare` b =
 231      (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
 232      (srcSpanEnd   a `compare` srcSpanEnd   b)
 233
 234 noSrcSpan  = UnhelpfulSpan FSLIT("<no location info>")
 235
 236 mkGeneralSrcSpan :: FastString -> SrcSpan
 237 mkGeneralSrcSpan = UnhelpfulSpan
 238
 239 isGoodSrcSpan SrcSpanOneLine{} = True
 240 isGoodSrcSpan SrcSpanMultiLine{} = True
 241 isGoodSrcSpan SrcSpanPoint{} = True
 242 isGoodSrcSpan _ = False
 243
 244 srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
 245 srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
 246 srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
 247 srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine"
 248
 249 srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
 250 srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
 251 srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
 252 srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine"
 253
 254 srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
 255 srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
 256 srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
 257 srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol"
 258
 259 srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
 260 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
 261 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
 262 srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
 263
 264 srcSpanStart (ImportedSpan str) = ImportedLoc str
 265 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
 266 srcSpanStart s =
 267   mkSrcLoc (srcSpanFile s)
 268            (srcSpanStartLine s)
 269            (srcSpanStartCol s)
 270
 271 srcSpanEnd (ImportedSpan str) = ImportedLoc str
 272 srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
 273 srcSpanEnd s =
 274   mkSrcLoc (srcSpanFile s)
 275            (srcSpanEndLine s)
 276            (srcSpanEndCol s)
 277
 278 srcLocSpan :: SrcLoc -> SrcSpan
 279 srcLocSpan (ImportedLoc str)  = ImportedSpan str
 280 srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
 281 srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
 282
 283 mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
 284 mkSrcSpan (ImportedLoc str) _  = ImportedSpan str
 285 mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
 286 mkSrcSpan _ (ImportedLoc str)  = ImportedSpan str
 287 mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
 288 mkSrcSpan loc1 loc2
 289   | line1 == line2 = if col1 == col2
 290                         then SrcSpanPoint file line1 col1
 291                         else SrcSpanOneLine file line1 col1 col2
 292   | otherwise      = SrcSpanMultiLine file line1 col1 line2 col2
 293   where
 294         line1 = srcLocLine loc1
 295         line2 = srcLocLine loc2
 296         col1 = srcLocCol loc1
 297         col2 = srcLocCol loc2
 298         file = srcLocFile loc1
 299
 300 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
 301 combineSrcSpans (ImportedSpan str) _  = ImportedSpan str
 302 combineSrcSpans (UnhelpfulSpan str) r = r -- this seems more useful
 303 combineSrcSpans _ (ImportedSpan str)  = ImportedSpan str
 304 combineSrcSpans l (UnhelpfulSpan str) = l
 305 combineSrcSpans start end
 306  | line1 == line2 = if col1 == col2
 307                         then SrcSpanPoint file line1 col1
 308                         else SrcSpanOneLine file line1 col1 col2
 309  | otherwise      = SrcSpanMultiLine file line1 col1 line2 col2
 310   where
 311         line1 = srcSpanStartLine start
 312         line2 = srcSpanEndLine end
 313         col1 = srcSpanStartCol start
 314         col2 = srcSpanEndCol end
 315         file = srcSpanFile start
 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("Imported from") <+> quotes (text 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}