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,
  34         srcSpanStartLine, srcSpanEndLine,
  35         srcSpanStartCol, srcSpanEndCol,
  36
  37         Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc
  38     ) where
  39
  40 #include "HsVersions.h"
  41
  42 import Util
  43 import Outputable
  44 import FastString
  45 \end{code}
  46
  47 %************************************************************************
  48 %*                                                                      *
  49 \subsection[SrcLoc-SrcLocations]{Source-location information}
  50 %*                                                                      *
  51 %************************************************************************
  52
  53 We keep information about the {\em definition} point for each entity;
  54 this is the obvious stuff:
  55 \begin{code}
  56 data SrcLoc
  57   = SrcLoc      FastString      -- A precise location (file name)
  58                 !Int            -- line number, begins at 1
  59                 !Int            -- column number, begins at 0
  60                 -- Don't ask me why lines start at 1 and columns start at
  61                 -- zero.  That's just the way it is, so there.  --SDM
  62
  63   | ImportedLoc String          -- Module name
  64
  65   | UnhelpfulLoc FastString     -- Just a general indication
  66 \end{code}
  67
  68 Note that an entity might be imported via more than one route, and
  69 there could be more than one ``definition point'' --- in two or more
  70 \tr{.hi} files.  We deemed it probably-unworthwhile to cater for this
  71 rare case.
  72
  73 %************************************************************************
  74 %*                                                                      *
  75 \subsection[SrcLoc-access-fns]{Access functions for names}
  76 %*                                                                      *
  77 %************************************************************************
  78
  79 Things to make 'em:
  80 \begin{code}
  81 mkSrcLoc x line col = SrcLoc x line col
  82 noSrcLoc          = UnhelpfulLoc FSLIT("<no location info>")
  83 generatedSrcLoc   = UnhelpfulLoc FSLIT("<compiler-generated code>")
  84 wiredInSrcLoc     = UnhelpfulLoc FSLIT("<wired into compiler>")
  85 interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
  86
  87 mkGeneralSrcLoc :: FastString -> SrcLoc
  88 mkGeneralSrcLoc = UnhelpfulLoc
  89
  90 importedSrcLoc :: String -> 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") <+> text 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 String         -- 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
 211 mkGeneralSrcSpan :: FastString -> SrcSpan
 212 mkGeneralSrcSpan = UnhelpfulSpan
 213
 214 isGoodSrcSpan SrcSpanOneLine{} = True
 215 isGoodSrcSpan SrcSpanMultiLine{} = True
 216 isGoodSrcSpan SrcSpanPoint{} = True
 217 isGoodSrcSpan _ = False
 218
 219 isOneLineSpan :: SrcSpan -> Bool
 220 -- True if the span is known to straddle more than one line
 221 -- By default, it returns False
 222 isOneLineSpan s
 223   | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s
 224   | otherwise       = False
 225
 226 --------------------------------------------------------
 227 -- Don't export these four;
 228 -- they panic on Imported, Unhelpful.
 229 -- They are for internal use only
 230 -- Urk!  Some are needed for Lexer.x; see comment in export list
 231
 232 srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
 233 srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
 234 srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
 235 srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine"
 236
 237 srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
 238 srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
 239 srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
 240 srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine"
 241
 242 srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
 243 srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
 244 srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
 245 srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol"
 246
 247 srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
 248 srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
 249 srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
 250 srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
 251 --------------------------------------------------------
 252
 253 srcSpanStart (ImportedSpan str) = ImportedLoc str
 254 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
 255 srcSpanStart s = mkSrcLoc (srcSpanFile s)
 256                           (srcSpanStartLine s)
 257                           (srcSpanStartCol s)
 258
 259 srcSpanEnd (ImportedSpan str) = ImportedLoc str
 260 srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
 261 srcSpanEnd s =
 262   mkSrcLoc (srcSpanFile s)
 263            (srcSpanEndLine s)
 264            (srcSpanEndCol s)
 265
 266 srcLocSpan :: SrcLoc -> SrcSpan
 267 srcLocSpan (ImportedLoc str)  = ImportedSpan str
 268 srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
 269 srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
 270
 271 mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
 272 mkSrcSpan (ImportedLoc str) _  = ImportedSpan str
 273 mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
 274 mkSrcSpan _ (ImportedLoc str)  = ImportedSpan str
 275 mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
 276 mkSrcSpan loc1 loc2
 277   | line1 == line2 = if col1 == col2
 278                         then SrcSpanPoint file line1 col1
 279                         else SrcSpanOneLine file line1 col1 col2
 280   | otherwise      = SrcSpanMultiLine file line1 col1 line2 col2
 281   where
 282         line1 = srcLocLine loc1
 283         line2 = srcLocLine loc2
 284         col1 = srcLocCol loc1
 285         col2 = srcLocCol loc2
 286         file = srcLocFile loc1
 287
 288 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
 289 -- Assumes the 'file' part is the same in both
 290 combineSrcSpans (ImportedSpan str) _  = ImportedSpan str
 291 combineSrcSpans (UnhelpfulSpan str) r = r -- this seems more useful
 292 combineSrcSpans _ (ImportedSpan str)  = ImportedSpan str
 293 combineSrcSpans l (UnhelpfulSpan str) = l
 294 combineSrcSpans start end
 295  = case line1 `compare` line2 of
 296      EQ -> case col1 `compare` col2 of
 297                 EQ -> SrcSpanPoint file line1 col1
 298                 LT -> SrcSpanOneLine file line1 col1 col2
 299                 GT -> SrcSpanOneLine file line1 col2 col1
 300      LT -> SrcSpanMultiLine file line1 col1 line2 col2
 301      GT -> SrcSpanMultiLine file line2 col2 line1 col1
 302   where
 303         line1 = srcSpanStartLine start
 304         col1  = srcSpanStartCol start
 305         line2 = srcSpanEndLine end
 306         col2  = srcSpanEndCol end
 307         file  = srcSpanFile start
 308
 309 pprDefnLoc :: SrcLoc -> SDoc
 310 -- "defined at ..." or "imported from ..."
 311 pprDefnLoc loc
 312   | isGoodSrcLoc loc = ptext SLIT("Defined at") <+> ppr loc
 313   | otherwise        = ppr loc
 314
 315 instance Outputable SrcSpan where
 316     ppr span
 317       = getPprStyle $ \ sty ->
 318         if userStyle sty || debugStyle sty then
 319            pprUserSpan span
 320         else
 321            hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
 322                  char '\"', ftext (srcSpanFile span), text " #-}"]
 323
 324
 325 pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
 326   = hcat [ ftext src_path, char ':',
 327            int line,
 328            char ':', int start_col
 329          ]
 330     <> if end_col - start_col <= 1
 331           then empty
 332             -- for single-character or point spans, we just output the starting
 333             -- column number
 334           else  char '-' <> int (end_col-1)
 335
 336 pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
 337   = hcat [ ftext src_path, char ':',
 338                   parens (int sline <> char ',' <>  int scol),
 339                   char '-',
 340                   parens (int eline <> char ',' <>
 341                            if ecol == 0 then int ecol else int (ecol-1))
 342                 ]
 343
 344 pprUserSpan (SrcSpanPoint src_path line col)
 345   = hcat [ ftext src_path, char ':',
 346            int line,
 347            char ':', int col
 348          ]
 349
 350 pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> text mod
 351 pprUserSpan (UnhelpfulSpan s)  = ftext s
 352 \end{code}
 353
 354 %************************************************************************
 355 %*                                                                      *
 356 \subsection[Located]{Attaching SrcSpans to things}
 357 %*                                                                      *
 358 %************************************************************************
 359
 360 \begin{code}
 361 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
 362 data Located e = L SrcSpan e
 363
 364 unLoc :: Located e -> e
 365 unLoc (L _ e) = e
 366
 367 getLoc :: Located e -> SrcSpan
 368 getLoc (L l _) = l
 369
 370 noLoc :: e -> Located e
 371 noLoc e = L noSrcSpan e
 372
 373 combineLocs :: Located a -> Located b -> SrcSpan
 374 combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
 375
 376 addCLoc :: Located a -> Located b -> c -> Located c
 377 addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
 378
 379 -- not clear whether to add a general Eq instance, but this is useful sometimes:
 380 eqLocated :: Eq a => Located a -> Located a -> Bool
 381 eqLocated a b = unLoc a == unLoc b
 382
 383 -- not clear whether to add a general Eq instance, but this is useful sometimes:
 384 cmpLocated :: Ord a => Located a -> Located a -> Ordering
 385 cmpLocated a b = unLoc a `compare` unLoc b
 386
 387 instance Functor Located where
 388   fmap f (L l e) = L l (f e)
 389
 390 instance Outputable e => Outputable (Located e) where
 391   ppr (L span e) =  ppr e
 392         -- do we want to dump the span in debugSty mode?
 393 \end{code}