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