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,
  25
  26         srcLocFile              -- return the file name part.
  27     ) where
  28
  29 #include "HsVersions.h"
  30
  31 import Util             ( thenCmp )
  32 import Outputable
  33 import FastString       ( unpackFS )
  34 import GlaExts          ( Int(..), (+#) )
  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   = NoSrcLoc
  48
  49   | SrcLoc      FAST_STRING     -- A precise location (file name)
  50                 FAST_INT
  51
  52   | UnhelpfulSrcLoc FAST_STRING -- Just a general indication
  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 noSrcLoc            = NoSrcLoc
  69 mkSrcLoc x IBOX(y)  = SrcLoc x y
  70
  71 mkIfaceSrcLoc       = UnhelpfulSrcLoc SLIT("<an interface file>")
  72 mkBuiltinSrcLoc     = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
  73 mkGeneratedSrcLoc   = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
  74
  75 isNoSrcLoc NoSrcLoc = True
  76 isNoSrcLoc other    = False
  77
  78 srcLocFile :: SrcLoc -> FAST_STRING
  79 srcLocFile (SrcLoc fname _) = fname
  80
  81 incSrcLine :: SrcLoc -> SrcLoc
  82 incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
  83 incSrcLine loc          = loc
  84 \end{code}
  85
  86 %************************************************************************
  87 %*                                                                      *
  88 \subsection[SrcLoc-instances]{Instance declarations for various names}
  89 %*                                                                      *
  90 %************************************************************************
  91
  92 \begin{code}
  93 -- SrcLoc is an instance of Ord so that we can sort error messages easily
  94 instance Eq SrcLoc where
  95   loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
  96                    EQ    -> True
  97                    other -> False
  98
  99 instance Ord SrcLoc where
 100   compare = cmpSrcLoc
 101
 102 cmpSrcLoc NoSrcLoc NoSrcLoc = EQ
 103 cmpSrcLoc NoSrcLoc other    = LT
 104
 105 cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2
 106 cmpSrcLoc (UnhelpfulSrcLoc s1) other                = GT
 107
 108 cmpSrcLoc (SrcLoc s1 l1) NoSrcLoc            = GT
 109 cmpSrcLoc (SrcLoc s1 l1) (UnhelpfulSrcLoc _) = LT
 110 cmpSrcLoc (SrcLoc s1 l1) (SrcLoc s2 l2)      = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2)
 111                                              where
 112                                                 l1 `cmpline` l2 | l1 <#  l2 = LT
 113                                                                 | l1 ==# l2 = EQ
 114                                                                 | otherwise = GT
 115
 116 instance Outputable SrcLoc where
 117     ppr (SrcLoc src_path src_line)
 118       = getPprStyle $ \ sty ->
 119         if userStyle sty then
 120            hcat [ text src_file, char ':', int IBOX(src_line) ]
 121         else
 122         if debugStyle sty then
 123            hcat [ ptext src_path, char ':', int IBOX(src_line) ]
 124         else
 125            hcat [text "{-# LINE ", int IBOX(src_line), space,
 126                  char '\"', ptext src_path, text " #-}"]
 127       where
 128         src_file = remove_directory_prefix (unpackFS src_path)
 129
 130         remove_directory_prefix path = case break (== '/') path of
 131                                           (filename, [])           -> filename
 132                                           (prefix,   slash : rest) -> ASSERT( slash == '/' )
 133                                                                       remove_directory_prefix rest
 134
 135     ppr (UnhelpfulSrcLoc s) = ptext s
 136
 137     ppr NoSrcLoc = text "<NoSrcLoc>"
 138 \end{code}