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, srcSpanEndLine, srcSpanEndCol,
  34
  35         Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc
  36     ) where
  37
  38 #include "HsVersions.h"
  39
  40 import Util
  41 import Outputable
  42 import FastString
  43 \end{code}
  44
  45 %************************************************************************
  46 %*                                                                      *
  47 \subsection[SrcLoc-SrcLocations]{Source-location information}
  48 %*                                                                      *
  49 %************************************************************************
  50
  51 We keep information about the {\em definition} point for each entity;
  52 this is the obvious stuff:
  53 \begin{code}
  54 data SrcLoc
  55   = SrcLoc      FastString      -- A precise location (file name)
  56                 !Int            -- line number, begins at 1
  57                 !Int            -- column number, begins at 0
  58                 -- Don't ask me why lines start at 1 and columns start at
  59                 -- zero.  That's just the way it is, so there.  --SDM
  60
  61   | ImportedLoc String          -- Module name
  62
  63   | UnhelpfulLoc FastString     -- Just a general indication
  64 \end{code}
  65
  66 Note that an entity might be imported via more than one route, and
  67 there could be more than one ``definition point'' --- in two or more
  68 \tr{.hi} files.  We deemed it probably-unworthwhile to cater for this
  69 rare case.
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection[SrcLoc-access-fns]{Access functions for names}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 Things to make 'em:
  78 \begin{code}
  79 mkSrcLoc x line col = SrcLoc x line col
  80 noSrcLoc          = UnhelpfulLoc FSLIT("<no location info>")
  81 generatedSrcLoc   = UnhelpfulLoc FSLIT("<compiler-generated code>")
  82 wiredInSrcLoc     = UnhelpfulLoc FSLIT("<wired into compiler>")
  83 interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
  84
  85 mkGeneralSrcLoc :: FastString -> SrcLoc
  86 mkGeneralSrcLoc = UnhelpfulLoc
  87
  88 importedSrcLoc :: String -> SrcLoc
  89 importedSrcLoc mod_name = ImportedLoc mod_name
  90
  91 isGoodSrcLoc (SrcLoc _ _ _) = True
  92 isGoodSrcLoc other          = False
  93
  94 srcLocFile :: SrcLoc -> FastString
  95 srcLocFile (SrcLoc fname _ _) = fname
  96 srcLocFile other              = FSLIT("<unknown file")
  97
  98 srcLocLine :: SrcLoc -> Int
  99 srcLocLine (SrcLoc _ l c) = l
 100 srcLocLine other          = panic "srcLocLine: unknown line"
 101
 102 srcLocCol :: SrcLoc -> Int
 103 srcLocCol (SrcLoc _ l c) = c
 104 srcLocCol other   = panic "srcLocCol: unknown col"
 105
 106 advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
 107 advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f  (l + 1) 0
 108 advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
 109 advanceSrcLoc loc            _    = loc -- Better than nothing
 110 \end{code}
 111
 112 %************************************************************************
 113 %*                                                                      *
 114 \subsection[SrcLoc-instances]{Instance declarations for various names}
 115 %*                                                                      *
 116 %************************************************************************
 117
 118 \begin{code}
 119 -- SrcLoc is an instance of Ord so that we can sort error messages easily
 120 instance Eq SrcLoc where
 121   loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
 122                    EQ    -> True
 123                    other -> False
 124
 125 instance Ord SrcLoc where
 126   compare = cmpSrcLoc
 127
 128 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
 129 cmpSrcLoc (UnhelpfulLoc _)  other             = LT
 130
 131 cmpSrcLoc (ImportedLoc _)  (UnhelpfulLoc _)  = GT
 132 cmpSrcLoc (ImportedLoc m1) (ImportedLoc m2)  = m1 `compare` m2
 133 cmpSrcLoc (ImportedLoc _)  other             = LT
 134
 135 cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
 136   = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
 137 cmpSrcLoc (SrcLoc _ _ _) other = GT
 138
 139 instance Outputable SrcLoc where
 140     ppr (SrcLoc src_path src_line src_col)
 141       = getPprStyle $ \ sty ->
 142         if userStyle sty || debugStyle sty then
 143            hcat [ ftext src_path, char ':',
 144                   int src_line,
 145                   char ':', int src_col
 146                 ]
 147         else
 148            hcat [text "{-# LINE ", int src_line, space,
 149                  char '\"', ftext src_path, text " #-}"]
 150
 151     ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> text mod
 152     ppr (UnhelpfulLoc s)  = ftext s
 153 \end{code}
 154
 155 %************************************************************************
 156 %*                                                                      *
 157 \subsection[SrcSpan]{Source Spans}
 158 %*                                                                      *
 159 %************************************************************************
 160
 161 \begin{code}
 162 {- |
 163 A SrcSpan delimits a portion of a text file.  It could be represented
 164 by a pair of (line,column) coordinates, but in fact we optimise
 165 slightly by using more compact representations for single-line and
 166 zero-length spans, both of which are quite common.
 167
 168 The end position is defined to be the column *after* the end of the
 169 span.  That is, a span of (1,1)-(1,2) is one character long, and a
 170 span of (1,1)-(1,1) is zero characters long.
 171 -}
 172 data SrcSpan
 173   = SrcSpanOneLine              -- a common case: a single line
 174         { srcSpanFile     :: FastString,
 175           srcSpanLine     :: !Int,
 176           srcSpanSCol     :: !Int,
 177           srcSpanECol     :: !Int
 178         }
 179
 180   | SrcSpanMultiLine
 181         { srcSpanFile     :: FastString,
 182           srcSpanSLine    :: !Int,
 183           srcSpanSCol     :: !Int,
 184           srcSpanELine    :: !Int,
 185           srcSpanECol     :: !Int
 186         }
 187
 188   | SrcSpanPoint
 189         { srcSpanFile     :: FastString,
 190           srcSpanLine     :: !Int,
 191           srcSpanCol      :: !Int
 192         }
 193
 194   | ImportedSpan String         -- Module name
 195
 196   | UnhelpfulSpan FastString    -- Just a general indication
 197                                 -- also used to indicate an empty span
 198
 199   deriving Eq
 200
 201 -- We want to order SrcSpans first by the start point, then by the end point.
 202 instance Ord SrcSpan where
 203   a `compare` b =
 204      (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
 205      (srcSpanEnd   a `compare` srcSpanEnd   b)
 206
 207 noSrcSpan  = UnhelpfulSpan FSLIT("<no location info>")
 208
 209 mkGeneralSrcSpan :: FastString -> SrcSpan
 210 mkGeneralSrcSpan = UnhelpfulSpan
 211
 212 isGoodSrcSpan SrcSpanOneLine{} = True
 213 isGoodSrcSpan SrcSpanMultiLine{} = True
 214 isGoodSrcSpan SrcSpanPoint{} = True
 215 isGoodSrcSpan _ = False
 216
 217 isOneLineSpan :: SrcSpan -> Bool
 218 -- True if the span is known to straddle more than one line
 219 -- By default, it returns False
 220 isOneLineSpan s
 221   | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s
 222   | otherwise       = False
 223
 224 --------------------------------------------------------
 225 -- Don't export these four;
 226 -- they panic on Imported, Unhelpful.
 227 -- They are for internal use only
 228 -- Urk!  Some are needed for Lexer.x; see comment in export list
 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
 251 srcSpanStart (ImportedSpan str) = ImportedLoc str
 252 srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
 253 srcSpanStart s = 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("Defined in") <+> 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}