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