ghc/compiler/ghci/CmSummarise.lhs

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