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
  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") <+> quotes (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 combineSrcSpans (ImportedSpan str) _  = ImportedSpan str
 288 combineSrcSpans (UnhelpfulSpan str) r = r -- this seems more useful
 289 combineSrcSpans _ (ImportedSpan str)  = ImportedSpan str
 290 combineSrcSpans l (UnhelpfulSpan str) = l
 291 combineSrcSpans start end
 292  | line1 == line2 = if col1 == col2
 293                         then SrcSpanPoint file line1 col1
 294                         else SrcSpanOneLine file line1 col1 col2
 295  | otherwise      = SrcSpanMultiLine file line1 col1 line2 col2
 296   where
 297         line1 = srcSpanStartLine start
 298         line2 = srcSpanEndLine end
 299         col1 = srcSpanStartCol start
 300         col2 = srcSpanEndCol end
 301         file = srcSpanFile start
 302
 303 instance Outputable SrcSpan where
 304     ppr span
 305       = getPprStyle $ \ sty ->
 306         if userStyle sty || debugStyle sty then
 307            pprUserSpan span
 308         else
 309            hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
 310                  char '\"', ftext (srcSpanFile span), text " #-}"]
 311
 312
 313 pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
 314   = hcat [ ftext src_path, char ':',
 315            int line,
 316            char ':', int start_col
 317          ]
 318     <> if end_col - start_col <= 1
 319           then empty
 320             -- for single-character or point spans, we just output the starting
 321             -- column number
 322           else  char '-' <> int (end_col-1)
 323
 324 pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
 325   = hcat [ ftext src_path, char ':',
 326                   parens (int sline <> char ',' <>  int scol),
 327                   char '-',
 328                   parens (int eline <> char ',' <>
 329                            if ecol == 0 then int ecol else int (ecol-1))
 330                 ]
 331
 332 pprUserSpan (SrcSpanPoint src_path line col)
 333   = hcat [ ftext src_path, char ':',
 334            int line,
 335            char ':', int col
 336          ]
 337
 338 pprUserSpan (ImportedSpan mod) = ptext SLIT("Imported from") <+> quotes (text mod)
 339 pprUserSpan (UnhelpfulSpan s)  = ftext s
 340 \end{code}
 341
 342 %************************************************************************
 343 %*                                                                      *
 344 \subsection[Located]{Attaching SrcSpans to things}
 345 %*                                                                      *
 346 %************************************************************************
 347
 348 \begin{code}
 349 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
 350 data Located e = L SrcSpan e
 351
 352 unLoc :: Located e -> e
 353 unLoc (L _ e) = e
 354
 355 getLoc :: Located e -> SrcSpan
 356 getLoc (L l _) = l
 357
 358 noLoc :: e -> Located e
 359 noLoc e = L noSrcSpan e
 360
 361 combineLocs :: Located a -> Located b -> SrcSpan
 362 combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
 363
 364 addCLoc :: Located a -> Located b -> c -> Located c
 365 addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
 366
 367 -- not clear whether to add a general Eq instance, but this is useful sometimes:
 368 eqLocated :: Eq a => Located a -> Located a -> Bool
 369 eqLocated a b = unLoc a == unLoc b
 370
 371 -- not clear whether to add a general Eq instance, but this is useful sometimes:
 372 cmpLocated :: Ord a => Located a -> Located a -> Ordering
 373 cmpLocated a b = unLoc a `compare` unLoc b
 374
 375 instance Functor Located where
 376   fmap f (L l e) = L l (f e)
 377
 378 instance Outputable e => Outputable (Located e) where
 379   ppr (L span e) = ppr e
 380         -- do we want to dump the span in debugSty mode?
 381 \end{code}