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