ghc/compiler/ghci/CmSummarise.lhs

   1 %
   2 % (c) The University of Glasgow, 2000
   3 %
   4 \section[CmSummarise]{Module summariser for GHCI}
   5
   6 \begin{code}
   7 module CmSummarise ( ModImport(..), mi_name,
   8                      ModSummary(..), summarise, ms_get_imports,
   9                      name_of_summary, deps_of_summary,
  10                      getImports )
  11 where
  12
  13 #include "HsVersions.h"
  14
  15 import List             ( nub )
  16 import Char             ( ord, isAlphaNum )
  17
  18 import CmFind           ( ModName, ModLocation(..), ml_modname )
  19 import Outputable
  20 \end{code}
  21
  22 \begin{code}
  23
  24
  25 -- The ModLocation contains the original source filename of the module.
  26 -- The ms_ppsource field contains another filename, which is intended to
  27 -- be the cleaned-up source file after all preprocessing has happened to
  28 -- it.  The point is that the summariser will have to cpp/unlit/whatever
  29 -- all files anyway, and there's no point in doing this twice -- just
  30 -- park the result in a temp file, put the name of it in ms_ppsource,
  31 -- and let @compile@ read from that file on the way back up.
  32 data ModSummary
  33    = ModSummary {
  34         ms_loc      :: ModLocation,                     -- location and kind
  35         ms_ppsource :: (Maybe (FilePath, Fingerprint)), -- preprocessed and sig if .hs
  36         ms_imports  :: (Maybe [ModImport])              -- imports if .hs or .hi
  37      }
  38
  39 instance Outputable ModSummary where
  40    ppr ms
  41       = sep [text "ModSummary {",
  42              nest 3 (sep [text "ms_loc =" <+> ppr (ms_loc ms),
  43              text "ms_ppsource =" <+> fooble (ms_ppsource ms),
  44              text "ms_imports=" <+> ppr (ms_imports ms)]),
  45              char '}'
  46             ]
  47         where
  48            fooble Nothing = text "Nothing"
  49            fooble (Just (cppd_source_name,fp))
  50               = text "(fp =" <+> int fp <> text ","
  51                 <+> text (show cppd_source_name) <> text ")"
  52
  53 data ModImport
  54    = MINormal ModName | MISource ModName
  55      deriving Eq
  56
  57 instance Outputable ModImport where
  58    ppr (MINormal nm) = text nm
  59    ppr (MISource nm) = text "{-# SOURCE #-}" <+> text nm
  60
  61
  62 mi_name (MINormal nm) = nm
  63 mi_name (MISource nm) = nm
  64
  65 name_of_summary :: ModSummary -> ModName
  66 name_of_summary = ml_modname . ms_loc
  67
  68 deps_of_summary :: ModSummary -> [ModName]
  69 deps_of_summary = map mi_name . ms_get_imports
  70
  71 ms_get_imports :: ModSummary -> [ModImport]
  72 ms_get_imports summ
  73    = case ms_imports summ of { Just is -> is; Nothing -> [] }
  74
  75 type Fingerprint = Int
  76
  77 summarise :: ModLocation -> IO ModSummary
  78
  79 summarise loc
  80    = case loc of
  81         InPackage mod path -- if in a package, investigate no further
  82            -> return (ModSummary loc Nothing Nothing)
  83         SourceOnly mod path -- source; read, cache and get imports
  84            -> readFile path >>= \ modsrc ->
  85               let imps = getImports modsrc
  86                   fp   = fingerprint modsrc
  87               in  return (ModSummary loc (Just (path,fp)) (Just imps))
  88         ObjectCode mod oPath hiPath -- can we get away with the src summariser
  89                                     -- for interface files?
  90            -> readFile hiPath >>= \ hisrc ->
  91               let imps = getImports hisrc
  92               in  return (ModSummary loc Nothing (Just imps))
  93         NotFound
  94            -> pprPanic "summarise:NotFound" (ppr loc)
  95
  96 fingerprint :: String -> Int
  97 fingerprint s
  98    = dofp s 3# 3#
  99      where
 100         -- Copied from hash() in Hugs' storage.c.
 101         dofp :: String -> Int# -> Int# -> Int
 102         dofp []     m fp = I# fp
 103         dofp (c:cs) m fp = dofp cs (m +# 1#) (iabs (fp +# m *# unbox (ord c)))
 104         unbox (I# i) = i
 105         iabs :: Int# -> Int#
 106         iabs n = if n <# 0# then 0# -# n else n
 107 \end{code}
 108
 109 Collect up the imports from a Haskell source module.  This is
 110 approximate: we don't parse the module, but we do eliminate comments
 111 and strings.  Doesn't currently know how to unlit or cppify the module
 112 first.
 113
 114 \begin{code}
 115
 116 getImports :: String -> [ModImport]
 117 getImports = nub . gmiBase . clean
 118
 119 -- really get the imports from a de-litted, cpp'd, de-literal'd string
 120 gmiBase :: String -> [ModImport]
 121 gmiBase s
 122    = f (words s)
 123      where
 124         f ("foreign" : "import" : ws) = f ws
 125         f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
 126            = MISource (takeWhile isModId m) : f ws
 127         f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
 128            = MISource (takeWhile isModId m) : f ws
 129         f ("import" : "qualified" : m : ws)
 130            = MINormal (takeWhile isModId m) : f ws
 131         f ("import" : m : ws)
 132            = MINormal (takeWhile isModId m) : f ws
 133         f (w:ws) = f ws
 134         f [] = []
 135
 136 isModId c = isAlphaNum c || c `elem` "'_"
 137
 138 -- remove literals and comments from a string
 139 clean :: String -> String
 140 clean s
 141    = keep s
 142      where
 143         -- running through text we want to keep
 144         keep []                   = []
 145         keep ('"':cs)             = dquote cs
 146                 -- try to eliminate single quotes when they're part of
 147                 -- an identifier...
 148         keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
 149         keep ('\'':cs)            = squote cs
 150         keep ('-':'-':cs)         = linecomment cs
 151         keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
 152         keep ('{':'-':cs)         = runcomment cs
 153         keep (c:cs)               = c : keep cs
 154
 155         -- in a double-quoted string
 156         dquote []             = []
 157         dquote ('\\':'\"':cs) = dquote cs
 158         dquote ('\\':'\\':cs) = dquote cs
 159         dquote ('\"':cs)      = keep cs
 160         dquote (c:cs)         = dquote cs
 161
 162         -- in a single-quoted string
 163         squote []             = []
 164         squote ('\\':'\'':cs) = squote cs
 165         squote ('\\':'\\':cs) = squote cs
 166         squote ('\'':cs)      = keep cs
 167         squote (c:cs)         = squote cs
 168
 169         -- in a line comment
 170         linecomment []        = []
 171         linecomment ('\n':cs) = '\n':keep cs
 172         linecomment (c:cs)    = linecomment cs
 173
 174         -- in a running comment
 175         runcomment []           = []
 176         runcomment ('-':'}':cs) = keep cs
 177         runcomment (c:cs)       = runcomment cs
 178 \end{code}