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
  53 instance Ord SrcLoc where
  54   compare NoSrcLoc NoSrcLoc           = EQ
  55   compare NoSrcLoc _                  = GT
  56   compare (UnhelpfulSrcLoc _) (UnhelpfulSrcLoc _) = EQ
  57   compare (UnhelpfulSrcLoc _) _       = GT
  58   compare _ NoSrcLoc                  = LT
  59   compare _ (UnhelpfulSrcLoc _)       = LT
  60   compare (SrcLoc _ y1) (SrcLoc _ y2) = compare IBOX(y1) IBOX(y2)
  61
  62 instance Eq SrcLoc where
  63   (==) x y = compare x y == EQ
  64
  65 \end{code}
  66
  67 Note that an entity might be imported via more than one route, and
  68 there could be more than one ``definition point'' --- in two or more
  69 \tr{.hi} files.  We deemed it probably-unworthwhile to cater for this
  70 rare case.
  71
  72 %************************************************************************
  73 %*                                                                      *
  74 \subsection[SrcLoc-access-fns]{Access functions for names}
  75 %*                                                                      *
  76 %************************************************************************
  77
  78 Things to make 'em:
  79 \begin{code}
  80 noSrcLoc            = NoSrcLoc
  81 mkSrcLoc x IBOX(y)  = SrcLoc x y
  82
  83 mkIfaceSrcLoc       = UnhelpfulSrcLoc SLIT("<an interface file>")
  84 mkBuiltinSrcLoc     = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
  85 mkGeneratedSrcLoc   = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
  86
  87 isNoSrcLoc NoSrcLoc = True
  88 isNoSrcLoc other    = False
  89
  90 srcLocFile :: SrcLoc -> FAST_STRING
  91 srcLocFile (SrcLoc fname _) = fname
  92
  93 incSrcLine :: SrcLoc -> SrcLoc
  94 incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
  95 incSrcLine loc          = loc
  96 \end{code}
  97
  98 %************************************************************************
  99 %*                                                                      *
 100 \subsection[SrcLoc-instances]{Instance declarations for various names}
 101 %*                                                                      *
 102 %************************************************************************
 103
 104 \begin{code}
 105 instance Outputable SrcLoc where
 106     ppr (SrcLoc src_path src_line)
 107       = getPprStyle $ \ sty ->
 108         if userStyle sty then
 109            hcat [ text src_file, char ':', int IBOX(src_line) ]
 110         else
 111         if debugStyle sty then
 112            hcat [ ptext src_path, char ':', int IBOX(src_line) ]
 113         else
 114            hcat [text "{-# LINE ", int IBOX(src_line), space,
 115                  char '\"', ptext src_path, text " #-}"]
 116       where
 117         src_file = remove_directory_prefix (unpackFS src_path)
 118
 119         remove_directory_prefix path = case break (== '/') path of
 120                                           (filename, [])           -> filename
 121                                           (prefix,   slash : rest) -> ASSERT( slash == '/' )
 122                                                                       remove_directory_prefix rest
 123
 124     ppr (UnhelpfulSrcLoc s) = ptext s
 125
 126     ppr NoSrcLoc = text "<NoSrcLoc>"
 127 \end{code}