ghc/compiler/compMan/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(..), mimp_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             ( isAlphaNum )
  17 import Util             ( unJust )
  18 import HscTypes         ( ModuleLocation(..) )
  19
  20 import Module
  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_imports  :: (Maybe [ModImport])              -- imports if .hs or .hi
  39      }
  40
  41 instance Outputable ModSummary where
  42    ppr ms
  43       = sep [text "ModSummary {",
  44              nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms) <> comma,
  45              text "ms_imports =" <+> ppr (ms_imports ms)]),
  46              char '}'
  47             ]
  48
  49 data ModImport
  50    = MINormal ModuleName | MISource ModuleName
  51      deriving Eq
  52
  53 instance Outputable ModImport where
  54    ppr (MINormal nm) = ppr nm
  55    ppr (MISource nm) = text "{-# SOURCE #-}" <+> ppr nm
  56
  57
  58 mimp_name (MINormal nm) = nm
  59 mimp_name (MISource nm) = nm
  60
  61 name_of_summary :: ModSummary -> ModuleName
  62 name_of_summary = moduleName . ms_mod
  63
  64 deps_of_summary :: ModSummary -> [ModuleName]
  65 deps_of_summary = map mimp_name . ms_get_imports
  66
  67 ms_get_imports :: ModSummary -> [ModImport]
  68 ms_get_imports summ
  69    = case ms_imports summ of { Just is -> is; Nothing -> [] }
  70
  71 type Fingerprint = Int
  72
  73 -- The first arg is supposed to be DriverPipeline.preprocess.
  74 -- Passed in here to avoid a hard-to-avoid circular dependency
  75 -- between CmSummarise and DriverPipeline.
  76 summarise :: (FilePath -> IO FilePath)
  77           -> Module -> ModuleLocation -> IO ModSummary
  78 summarise preprocess mod location
  79    | isModuleInThisPackage mod
  80    = do let hs_fn = unJust (ml_hs_file location) "summarise"
  81         hspp_fn <- preprocess hs_fn
  82         modsrc <- readFile hspp_fn
  83         let imps = getImports modsrc
  84         return (ModSummary mod location{ml_hspp_file=Just hspp_fn} (Just imps))
  85    | otherwise
  86    = return (ModSummary mod location Nothing)
  87 \end{code}
  88
  89 Collect up the imports from a Haskell source module.  This is
  90 approximate: we don't parse the module, but we do eliminate comments
  91 and strings.  Doesn't currently know how to unlit or cppify the module
  92 first.
  93
  94 \begin{code}
  95
  96 getImports :: String -> [ModImport]
  97 getImports = nub . gmiBase . clean
  98
  99 -- really get the imports from a de-litted, cpp'd, de-literal'd string
 100 gmiBase :: String -> [ModImport]
 101 gmiBase s
 102    = f (words s)
 103      where
 104         f ("foreign" : "import" : ws) = f ws
 105         f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
 106            = MISource (mkMN m) : f ws
 107         f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
 108            = MISource (mkMN m) : f ws
 109         f ("import" : "qualified" : m : ws)
 110            = MINormal (mkMN m) : f ws
 111         f ("import" : m : ws)
 112            = MINormal (mkMN m) : f ws
 113         f (w:ws) = f ws
 114         f [] = []
 115
 116         mkMN str = mkModuleName (takeWhile isModId str)
 117         isModId c = isAlphaNum c || c `elem` "'_"
 118
 119 -- remove literals and comments from a string
 120 clean :: String -> String
 121 clean s
 122    = keep s
 123      where
 124         -- running through text we want to keep
 125         keep []                   = []
 126         keep ('"':cs)             = dquote cs           -- "
 127                 -- try to eliminate single quotes when they're part of
 128                 -- an identifier...
 129         keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
 130         keep ('\'':cs)            = squote cs
 131         keep ('-':'-':cs)         = linecomment cs
 132         keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
 133         keep ('{':'-':cs)         = runcomment cs       -- -}
 134         keep (c:cs)               = c : keep cs
 135
 136         -- in a double-quoted string
 137         dquote []             = []
 138         dquote ('\\':'\"':cs) = dquote cs               -- "
 139         dquote ('\\':'\\':cs) = dquote cs
 140         dquote ('\"':cs)      = keep cs                 -- "
 141         dquote (c:cs)         = dquote cs
 142
 143         -- in a single-quoted string
 144         squote []             = []
 145         squote ('\\':'\'':cs) = squote cs
 146         squote ('\\':'\\':cs) = squote cs
 147         squote ('\'':cs)      = keep cs
 148         squote (c:cs)         = squote cs
 149
 150         -- in a line comment
 151         linecomment []        = []
 152         linecomment ('\n':cs) = '\n':keep cs
 153         linecomment (c:cs)    = linecomment cs
 154
 155         -- in a running comment
 156         runcomment []           = []
 157         runcomment ('-':'}':cs) = keep cs
 158         runcomment (c:cs)       = runcomment cs
 159 \end{code}