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         wiredInSrcLoc,          -- Something wired into the compiler
  15         generatedSrcLoc,        -- Code generated within the compiler
  16         interactiveSrcLoc,      -- Code from an interactive session
  17
  18         srcLocFile,             -- return the file name part
  19         srcLocLine,             -- return the line part
  20         srcLocCol,              -- return the column part
  21         pprDefnLoc,
  22
  23         SrcSpan,                -- Abstract
  24         noSrcSpan,
  25         mkGeneralSrcSpan,
  26         isGoodSrcSpan, isOneLineSpan,
  27         mkSrcSpan, srcLocSpan,
  28         combineSrcSpans,
  29         srcSpanStart, srcSpanEnd,
  30
  31         -- These are dubious exports, because they crash on some inputs,
  32         -- used only in Lexer.x where we are sure what the Span looks like
  33         srcSpanFile, srcSpanEndLine, srcSpanEndCol,
  34
  35         Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc
  36     ) where
  37
  38 #include "HsVersions.h"
  39
  40 import Util
  41 import Outputable
  42 import FastString
  43 \end{code}
  44
  45 %************************************************************************
  46 %*                                                                      *
  47 \subsection[SrcLoc-SrcLocations]{Source-location information}
  48 %*                                                                      *
  49 %************************************************************************
  50
  51 We keep information about the {\em definition} point for each entity;
  52 this is the obvious stuff:
  53 \begin{code}
  54 data SrcLoc
  55   = SrcLoc      FastString      -- A precise location (file name)
  56                 !Int            -- line number, begins at 1
  57                 !Int            -- column number, begins at 0
  58                 -- Don't ask me why lines start at 1 and columns start at
  59                 -- zero.  That's just the way it is, so there.  --SDM
  60
  61   | ImportedLoc String          -- Module name
  62
  63   | UnhelpfulLoc FastString     -- Just a general indication
  64 \end{code}
  65
  66 Note that an entity might be imported via more than one route, and
  67 there could be more than one ``definition point'' --- in two or more
  68 \tr{.hi} files.  We deemed it probably-unworthwhile to cater for this
  69 rare case.
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection[SrcLoc-access-fns]{Access functions for names}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 Things to make 'em:
  78 \begin{code}
  79 mkSrcLoc x line col = SrcLoc x line col
  80 noSrcLoc          = UnhelpfulLoc FSLIT("<no location info>")
  81 generatedSrcLoc   = UnhelpfulLoc FSLIT("<compiler-generated code>")
  82 wiredInSrcLoc     = UnhelpfulLoc FSLIT("<wired into compiler>")
  83 interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
  84
  85 mkGeneralSrcLoc :: FastString -> SrcLoc
  86 mkGeneralSrcLoc = UnhelpfulLoc
  87
  88 importedSrcLoc :: String -> SrcLoc
  89 importedSrcLoc mod_name = ImportedLoc mod_name
  90
  91 isGoodSrcLoc (SrcLoc _ _ _) = True
  92 isGoodSrcLoc other          = False
  93
  94 srcLocFile :: SrcLoc -> FastString
  95 srcLocFile (SrcLoc fname _ _) = fname
  96 srcLocFile other              = FSLIT("<unknown file")
  97
  98 srcLocLine :: SrcLoc -> Int
  99 srcLocLine (SrcLoc _ l c) = l
 100 srcLocLine other          = panic "srcLocLine: unknown line"
 101
 102 srcLocCol :: SrcLoc -> Int
 103 srcLocCol (SrcLoc _ l c) = c
 104 srcLocCol other   = panic "srcLocCol: unknown col"
 105
 106 advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
 107 advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f  (l + 1) 0
 108 advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
 109 advanceSrcLoc loc            _    = loc -- Better than nothing
 110 \end{code}
 111
 112 %************************************************************************
 113 %*                                                                      *
 114 \subsection[SrcLoc-instances]{Instance declarations for various names}
 115 %*                                                                      *
 116 %************************************************************************
 117
 118 \begin{code}
 119 -- SrcLoc is an instance of Ord so that we can sort error messages easily
 120 instance Eq SrcLoc where
 121   loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
 122                    EQ    -> True
 123                    other -> False
 124
 125 instance Ord SrcLoc where
 126   compare = cmpSrcLoc
 127
 128 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
 129 cmpSrcLoc (UnhelpfulLoc _)  other             = LT
 130
 131 cmpSrcLoc (ImportedLoc _)  (UnhelpfulLoc _)  = GT
 132 cmpSrcLoc (ImportedLoc m1) (ImportedLoc m2)  = m1 `compare` m2
 133 cmpSrcLoc (ImportedLoc _)  other             = LT
 134
 135 cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
 136   = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) `thenCmp` (c1 `cmpline` c2)
 137   where
 138         l1 `cmpline` l2 | l1 <  l2 = LT
 139                         | l1 == l2 = EQ
 140                         | otherwise = GT
 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") <+> text 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 String         -- 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
 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 :: SrcLoc -> SDoc
 312 -- "defined at ..." or "imported from ..."
 313 pprDefnLoc loc
 314   | isGoodSrcLoc 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") <+> 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}