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