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, isWiredInLoc,
  15         noSrcLoc,               -- "I'm sorry, I haven't a clue"
  16         advanceSrcLoc,
  17
  18         importedSrcLoc,         -- Unknown place in an interface
  19         wiredInSrcLoc,          -- Something wired into the compiler
  20         generatedSrcLoc,        -- Code generated within the compiler
  21
  22         srcLocFile,             -- return the file name part
  23         srcLocLine,             -- return the line part
  24         srcLocCol,              -- return the column 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          ( (+#), quotInt# )
  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   = WiredInLoc          -- Used exclusively for Ids and TyCons
  49                         -- that are totally wired in to the
  50                         -- compiler.  That supports the
  51                         -- occasionally-useful predicate
  52                         -- isWiredInName
  53
  54   | SrcLoc      FastString      -- A precise location (file name)
  55                 FastInt         -- line
  56                 FastInt         -- column
  57
  58   | UnhelpfulSrcLoc FastString  -- Just a general indication
  59
  60 {-
  61 data SrcSpan
  62   = WiredInSpan
  63
  64         -- A precise source file span
  65   | SrcSpan     FastString      -- file name
  66                 FastInt         -- beginning line
  67                 FastInt         -- beginning column
  68                 FastInt         -- end line
  69                 FastInt         -- end column
  70
  71   | UnhelpfulSrcSpan FastString -- Just a general indication
  72 -}
  73 \end{code}
  74
  75 Note that an entity might be imported via more than one route, and
  76 there could be more than one ``definition point'' --- in two or more
  77 \tr{.hi} files.  We deemed it probably-unworthwhile to cater for this
  78 rare case.
  79
  80 %************************************************************************
  81 %*                                                                      *
  82 \subsection[SrcLoc-access-fns]{Access functions for names}
  83 %*                                                                      *
  84 %************************************************************************
  85
  86 Things to make 'em:
  87 \begin{code}
  88 mkSrcLoc x line col = SrcLoc x (iUnbox line) (iUnbox col)
  89 wiredInSrcLoc     = WiredInLoc
  90 noSrcLoc          = UnhelpfulSrcLoc FSLIT("<No locn>")
  91 importedSrcLoc    = UnhelpfulSrcLoc FSLIT("<imported>")
  92 generatedSrcLoc   = UnhelpfulSrcLoc FSLIT("<compiler-generated-code>")
  93
  94 isGoodSrcLoc (SrcLoc _ _ _) = True
  95 isGoodSrcLoc other        = False
  96
  97 isWiredInLoc WiredInLoc = True
  98 isWiredInLoc other      = False
  99
 100 srcLocFile :: SrcLoc -> FastString
 101 srcLocFile (SrcLoc fname _ _) = fname
 102
 103 srcLocLine :: SrcLoc -> Int
 104 srcLocLine (SrcLoc _ l c) = iBox l
 105
 106 srcLocCol :: SrcLoc -> Int
 107 srcLocCol (SrcLoc _ l c) = iBox c
 108
 109 advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
 110 advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f  l (tab c)
 111 advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f  (l +# 1#) 0#
 112 advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c +# 1#)
 113
 114 -- Advance to the next tab stop.  Tabs are at column positions 0, 8, 16, etc.
 115 tab :: FastInt -> FastInt
 116 tab c = (c `quotInt#` 8# +# 1#) *# 8#
 117 \end{code}
 118
 119 %************************************************************************
 120 %*                                                                      *
 121 \subsection[SrcLoc-instances]{Instance declarations for various names}
 122 %*                                                                      *
 123 %************************************************************************
 124
 125 \begin{code}
 126 -- SrcLoc is an instance of Ord so that we can sort error messages easily
 127 instance Eq SrcLoc where
 128   loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
 129                    EQ    -> True
 130                    other -> False
 131
 132 instance Ord SrcLoc where
 133   compare = cmpSrcLoc
 134
 135 cmpSrcLoc WiredInLoc WiredInLoc = EQ
 136 cmpSrcLoc WiredInLoc other      = LT
 137
 138 cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2
 139 cmpSrcLoc (UnhelpfulSrcLoc s1) other                = GT
 140
 141 cmpSrcLoc (SrcLoc _ _ _) WiredInLoc          = GT
 142 cmpSrcLoc (SrcLoc _ _ _) (UnhelpfulSrcLoc _) = LT
 143 cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
 144   = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) `thenCmp` (c1 `cmpline` c2)
 145   where
 146         l1 `cmpline` l2 | l1 <#  l2 = LT
 147                         | l1 ==# l2 = EQ
 148                         | otherwise = GT
 149
 150 instance Outputable SrcLoc where
 151     ppr (SrcLoc src_path src_line src_col)
 152       = getPprStyle $ \ sty ->
 153         if userStyle sty || debugStyle sty then
 154            hcat [ ftext src_path, char ':',
 155                   int (iBox src_line)
 156                   {- TODO: char ':', int (iBox src_col) -}
 157                 ]
 158         else
 159            hcat [text "{-# LINE ", int (iBox src_line), space,
 160                  char '\"', ftext src_path, text " #-}"]
 161       where
 162         src_file = unpackFS src_path    -- Leave the directory prefix intact,
 163                                         -- so emacs can find the file
 164
 165     ppr (UnhelpfulSrcLoc s) = ftext s
 166     ppr WiredInLoc          = ptext SLIT("<Wired in>")
 167 \end{code}