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