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