ghc/compiler/basicTypes/SrcLoc.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   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,
  15         noSrcLoc,               -- "I'm sorry, I haven't a clue"
  16
  17         importedSrcLoc,         -- Unknown place in an interface
  18         builtinSrcLoc,          -- Something wired into the compiler
  19         generatedSrcLoc,        -- Code generated within the compiler
  20
  21         incSrcLine, replaceSrcLine,
  22
  23         srcLocFile,             -- return the file name part.
  24         srcLocLine              -- return the line part.
  25     ) where
  26
  27 #include "HsVersions.h"
  28
  29 import Util             ( thenCmp )
  30 import Outputable
  31 import FastString       ( unpackFS )
  32 import FastTypes
  33 import FastString
  34 import GlaExts          ( (+#) )
  35 \end{code}
  36
  37 %************************************************************************
  38 %*                                                                      *
  39 \subsection[SrcLoc-SrcLocations]{Source-location information}
  40 %*                                                                      *
  41 %************************************************************************
  42
  43 We keep information about the {\em definition} point for each entity;
  44 this is the obvious stuff:
  45 \begin{code}
  46 data SrcLoc
  47   = SrcLoc      FastString      -- A precise location (file name)
  48                 FastInt
  49
  50   | UnhelpfulSrcLoc FastString  -- Just a general indication
  51
  52   | NoSrcLoc
  53 \end{code}
  54
  55 Note that an entity might be imported via more than one route, and
  56 there could be more than one ``definition point'' --- in two or more
  57 \tr{.hi} files.  We deemed it probably-unworthwhile to cater for this
  58 rare case.
  59
  60 %************************************************************************
  61 %*                                                                      *
  62 \subsection[SrcLoc-access-fns]{Access functions for names}
  63 %*                                                                      *
  64 %************************************************************************
  65
  66 Things to make 'em:
  67 \begin{code}
  68 mkSrcLoc x y      = SrcLoc x (iUnbox y)
  69 noSrcLoc          = NoSrcLoc
  70 importedSrcLoc    = UnhelpfulSrcLoc FSLIT("<imported>")
  71 builtinSrcLoc     = UnhelpfulSrcLoc FSLIT("<built-into-the-compiler>")
  72 generatedSrcLoc   = UnhelpfulSrcLoc FSLIT("<compiler-generated-code>")
  73
  74 isGoodSrcLoc (SrcLoc _ _) = True
  75 isGoodSrcLoc other        = False
  76
  77 srcLocFile :: SrcLoc -> FastString
  78 srcLocFile (SrcLoc fname _) = fname
  79
  80 srcLocLine :: SrcLoc -> FastInt
  81 srcLocLine (SrcLoc _ l) = l
  82
  83 incSrcLine :: SrcLoc -> SrcLoc
  84 incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
  85 incSrcLine loc          = loc
  86
  87 replaceSrcLine :: SrcLoc -> FastInt -> SrcLoc
  88 replaceSrcLine (SrcLoc s _) l = SrcLoc s l
  89 \end{code}
  90
  91 %************************************************************************
  92 %*                                                                      *
  93 \subsection[SrcLoc-instances]{Instance declarations for various names}
  94 %*                                                                      *
  95 %************************************************************************
  96
  97 \begin{code}
  98 -- SrcLoc is an instance of Ord so that we can sort error messages easily
  99 instance Eq SrcLoc where
 100   loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
 101                    EQ    -> True
 102                    other -> False
 103
 104 instance Ord SrcLoc where
 105   compare = cmpSrcLoc
 106
 107 cmpSrcLoc NoSrcLoc NoSrcLoc = EQ
 108 cmpSrcLoc NoSrcLoc other    = LT
 109
 110 cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2
 111 cmpSrcLoc (UnhelpfulSrcLoc s1) other                = GT
 112
 113 cmpSrcLoc (SrcLoc s1 l1) NoSrcLoc            = GT
 114 cmpSrcLoc (SrcLoc s1 l1) (UnhelpfulSrcLoc _) = LT
 115 cmpSrcLoc (SrcLoc s1 l1) (SrcLoc s2 l2)      = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2)
 116                                              where
 117                                                 l1 `cmpline` l2 | l1 <#  l2 = LT
 118                                                                 | l1 ==# l2 = EQ
 119                                                                 | otherwise = GT
 120
 121 instance Outputable SrcLoc where
 122     ppr (SrcLoc src_path src_line)
 123       = getPprStyle $ \ sty ->
 124         if userStyle sty || debugStyle sty then
 125            hcat [ ftext src_path, char ':', int (iBox src_line) ]
 126         else
 127            hcat [text "{-# LINE ", int (iBox src_line), space,
 128                  char '\"', ftext src_path, text " #-}"]
 129       where
 130         src_file = unpackFS src_path    -- Leave the directory prefix intact,
 131                                         -- so emacs can find the file
 132
 133     ppr (UnhelpfulSrcLoc s) = ftext s
 134     ppr NoSrcLoc            = ptext SLIT("<No locn>")
 135 \end{code}