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