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