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 where
  10
  11 #include "HsVersions.h"
  12
  13 import List             ( nub )
  14 import Char             ( ord, isAlphaNum )
  15
  16 import CmFind           ( ModName, ModLocation(..) )
  17 import Outputable       ( pprPanic, text )
  18 \end{code}
  19
  20 \begin{code}
  21
  22
  23 data ModSummary
  24    = ModSummary {
  25         ms_loc     :: ModLocation,                   -- location and kind
  26         ms_source  :: (Maybe (String, Fingerprint)), -- source and sig if .hs
  27         ms_imports :: (Maybe [ModImport])            -- imports if .hs or .hi
  28      }
  29      deriving Show
  30
  31 data ModImport
  32    = MINormal ModName | MISource ModName
  33      deriving (Eq, Show)
  34
  35 mi_name (MINormal nm) = nm
  36 mi_name (MISource nm) = nm
  37
  38 ms_get_imports :: ModSummary -> [ModImport]
  39 ms_get_imports summ
  40    = case ms_imports summ of { Just is -> is; Nothing -> [] }
  41
  42 type Fingerprint = Int
  43
  44 summarise :: ModLocation -> IO ModSummary
  45
  46 summarise loc
  47    = case loc of
  48         InPackage mod path -- if in a package, investigate no further
  49            -> return (ModSummary loc Nothing Nothing)
  50         SourceOnly mod path -- source; read, cache and get imports
  51            -> readFile path >>= \ modsrc ->
  52               let imps = getImports modsrc
  53                   fp   = fingerprint modsrc
  54               in  return (ModSummary loc (Just (modsrc,fp)) (Just imps))
  55         ObjectCode mod oPath hiPath -- can we get away with the src summariser
  56                                     -- for interface files?
  57            -> readFile hiPath >>= \ hisrc ->
  58               let imps = getImports hisrc
  59               in  return (ModSummary loc Nothing (Just imps))
  60         NotFound
  61            -> pprPanic "summarise:NotFound" (text (show loc))
  62
  63 fingerprint :: String -> Int
  64 fingerprint s
  65    = dofp s 3 3
  66      where
  67         -- Copied from hash() in Hugs' storage.c.
  68         dofp :: String -> Int -> Int -> Int
  69         dofp []     m fp = fp
  70         dofp (c:cs) m fp = dofp cs (m+1) (iabs (fp + m * ord c))
  71         iabs :: Int -> Int
  72         iabs n = if n < 0 then -n else n
  73 \end{code}
  74
  75 Collect up the imports from a Haskell source module.  This is
  76 approximate: we don't parse the module, but we do eliminate comments
  77 and strings.  Doesn't currently know how to unlit or cppify the module
  78 first.
  79
  80 \begin{code}
  81
  82 getImports :: String -> [ModImport]
  83 getImports = nub . gmiBase . clean
  84
  85 -- really get the imports from a de-litted, cpp'd, de-literal'd string
  86 gmiBase :: String -> [ModImport]
  87 gmiBase s
  88    = f (words s)
  89      where
  90         f ("foreign" : "import" : ws) = f ws
  91         f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
  92            = MISource (takeWhile isModId m) : f ws
  93         f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
  94            = MISource (takeWhile isModId m) : f ws
  95         f ("import" : "qualified" : m : ws)
  96            = MINormal (takeWhile isModId m) : f ws
  97         f ("import" : m : ws)
  98            = MINormal (takeWhile isModId m) : f ws
  99         f (w:ws) = f ws
 100         f [] = []
 101
 102 isModId c = isAlphaNum c || c `elem` "'_"
 103
 104 -- remove literals and comments from a string
 105 clean :: String -> String
 106 clean s
 107    = keep s
 108      where
 109         -- running through text we want to keep
 110         keep []                   = []
 111         keep ('"':cs)             = dquote cs
 112                 -- try to eliminate single quotes when they're part of
 113                 -- an identifier...
 114         keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
 115         keep ('\'':cs)            = squote cs
 116         keep ('-':'-':cs)         = linecomment cs
 117         keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
 118         keep ('{':'-':cs)         = runcomment cs
 119         keep (c:cs)               = c : keep cs
 120
 121         -- in a double-quoted string
 122         dquote []             = []
 123         dquote ('\\':'\"':cs) = dquote cs
 124         dquote ('\\':'\\':cs) = dquote cs
 125         dquote ('\"':cs)      = keep cs
 126         dquote (c:cs)         = dquote cs
 127
 128         -- in a single-quoted string
 129         squote []             = []
 130         squote ('\\':'\'':cs) = squote cs
 131         squote ('\\':'\\':cs) = squote cs
 132         squote ('\'':cs)      = keep cs
 133         squote (c:cs)         = squote cs
 134
 135         -- in a line comment
 136         linecomment []        = []
 137         linecomment ('\n':cs) = '\n':keep cs
 138         linecomment (c:cs)    = linecomment cs
 139
 140         -- in a running comment
 141         runcomment []           = []
 142         runcomment ('-':'}':cs) = keep cs
 143         runcomment (c:cs)       = runcomment cs
 144 \end{code}