ghc/compiler/basicTypes/SrcLoc.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
   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     ) where
  26
  27 #include "HsVersions.h"
  28
  29 import Outputable
  30 import FastString       ( unpackFS )
  31 import GlaExts          ( Int(..), Int#, (+#) )
  32 \end{code}
  33
  34 %************************************************************************
  35 %*                                                                      *
  36 \subsection[SrcLoc-SrcLocations]{Source-location information}
  37 %*                                                                      *
  38 %************************************************************************
  39
  40 We keep information about the {\em definition} point for each entity;
  41 this is the obvious stuff:
  42 \begin{code}
  43 data SrcLoc
  44   = NoSrcLoc
  45
  46   | SrcLoc      FAST_STRING     -- A precise location (file name)
  47                 FAST_INT
  48
  49   | UnhelpfulSrcLoc FAST_STRING -- Just a general indication
  50 \end{code}
  51
  52 Note that an entity might be imported via more than one route, and
  53 there could be more than one ``definition point'' --- in two or more
  54 \tr{.hi} files.  We deemed it probably-unworthwhile to cater for this
  55 rare case.
  56
  57 %************************************************************************
  58 %*                                                                      *
  59 \subsection[SrcLoc-access-fns]{Access functions for names}
  60 %*                                                                      *
  61 %************************************************************************
  62
  63 Things to make 'em:
  64 \begin{code}
  65 noSrcLoc            = NoSrcLoc
  66 mkSrcLoc x IBOX(y)  = SrcLoc x y
  67
  68 mkIfaceSrcLoc       = UnhelpfulSrcLoc SLIT("<an interface file>")
  69 mkBuiltinSrcLoc     = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
  70 mkGeneratedSrcLoc   = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
  71
  72 isNoSrcLoc NoSrcLoc = True
  73 isNoSrcLoc other    = False
  74
  75 incSrcLine :: SrcLoc -> SrcLoc
  76 incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
  77 incSrcLine loc          = loc
  78 \end{code}
  79
  80 %************************************************************************
  81 %*                                                                      *
  82 \subsection[SrcLoc-instances]{Instance declarations for various names}
  83 %*                                                                      *
  84 %************************************************************************
  85
  86 \begin{code}
  87 instance Outputable SrcLoc where
  88     ppr (SrcLoc src_path src_line)
  89       = getPprStyle $ \ sty ->
  90         if userStyle sty then
  91            hcat [ text src_file, char ':', int IBOX(src_line) ]
  92         else
  93         if debugStyle sty then
  94            hcat [ ptext src_path, char ':', int IBOX(src_line) ]
  95         else
  96            hcat [text "{-# LINE ", int IBOX(src_line), space,
  97                  char '\"', ptext src_path, text " #-}"]
  98       where
  99         src_file = remove_directory_prefix (unpackFS src_path)
 100
 101         remove_directory_prefix path = case break (== '/') path of
 102                                           (filename, [])           -> filename
 103                                           (prefix,   slash : rest) -> ASSERT( slash == '/' )
 104                                                                       remove_directory_prefix rest
 105
 106     ppr (UnhelpfulSrcLoc s) = ptext s
 107
 108     ppr NoSrcLoc = text "<NoSrcLoc>"
 109 \end{code}