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 Outputable
  32 import FastString       ( unpackFS )
  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   = NoSrcLoc
  47
  48   | SrcLoc      FAST_STRING     -- A precise location (file name)
  49                 FAST_INT
  50
  51   | UnhelpfulSrcLoc FAST_STRING -- Just a general indication
  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 noSrcLoc            = NoSrcLoc
  68 mkSrcLoc x IBOX(y)  = SrcLoc x y
  69
  70 mkIfaceSrcLoc       = UnhelpfulSrcLoc SLIT("<an interface file>")
  71 mkBuiltinSrcLoc     = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
  72 mkGeneratedSrcLoc   = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
  73
  74 isNoSrcLoc NoSrcLoc = True
  75 isNoSrcLoc other    = False
  76
  77 srcLocFile :: SrcLoc -> FAST_STRING
  78 srcLocFile (SrcLoc fname _) = fname
  79
  80 incSrcLine :: SrcLoc -> SrcLoc
  81 incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
  82 incSrcLine loc          = loc
  83 \end{code}
  84
  85 %************************************************************************
  86 %*                                                                      *
  87 \subsection[SrcLoc-instances]{Instance declarations for various names}
  88 %*                                                                      *
  89 %************************************************************************
  90
  91 \begin{code}
  92 instance Outputable SrcLoc where
  93     ppr (SrcLoc src_path src_line)
  94       = getPprStyle $ \ sty ->
  95         if userStyle sty then
  96            hcat [ text src_file, char ':', int IBOX(src_line) ]
  97         else
  98         if debugStyle sty then
  99            hcat [ ptext src_path, char ':', int IBOX(src_line) ]
 100         else
 101            hcat [text "{-# LINE ", int IBOX(src_line), space,
 102                  char '\"', ptext src_path, text " #-}"]
 103       where
 104         src_file = remove_directory_prefix (unpackFS src_path)
 105
 106         remove_directory_prefix path = case break (== '/') path of
 107                                           (filename, [])           -> filename
 108                                           (prefix,   slash : rest) -> ASSERT( slash == '/' )
 109                                                                       remove_directory_prefix rest
 110
 111     ppr (UnhelpfulSrcLoc s) = ptext s
 112
 113     ppr NoSrcLoc = text "<NoSrcLoc>"
 114 \end{code}