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