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, is_source_import,
  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 is_source_import (MINormal _) = False
  62 is_source_import (MISource _) = True
  63
  64 name_of_summary :: ModSummary -> ModuleName
  65 name_of_summary = moduleName . ms_mod
  66
  67 deps_of_summary :: ModSummary -> [ModuleName]
  68 deps_of_summary = map mimp_name . ms_get_imports
  69
  70 ms_get_imports :: ModSummary -> [ModImport]
  71 ms_get_imports summ
  72    = case ms_imports summ of { Just is -> is; Nothing -> [] }
  73
  74 type Fingerprint = Int
  75
  76 -- The first arg is supposed to be DriverPipeline.preprocess.
  77 -- Passed in here to avoid a hard-to-avoid circular dependency
  78 -- between CmSummarise and DriverPipeline.  Same deal as with
  79 -- CmLink.link.
  80 summarise :: (FilePath -> IO FilePath)
  81           -> Module -> ModuleLocation -> IO ModSummary
  82 summarise preprocess mod location
  83    | isModuleInThisPackage mod
  84    = do let hs_fn = unJust (ml_hs_file location) "summarise"
  85         hspp_fn <- preprocess hs_fn
  86         modsrc <- readFile hspp_fn
  87         let imps = getImports modsrc
  88         return (ModSummary mod location{ml_hspp_file=Just hspp_fn} (Just imps))
  89    | otherwise
  90    = return (ModSummary mod location Nothing)
  91 \end{code}
  92
  93 Collect up the imports from a Haskell source module.  This is
  94 approximate: we don't parse the module, but we do eliminate comments
  95 and strings.  Doesn't currently know how to unlit or cppify the module
  96 first.
  97
  98 NB !!!!! Ignores source imports, pro tem.
  99
 100 \begin{code}
 101
 102 getImports :: String -> [ModImport]
 103 getImports = filter (not . is_source_import) .
 104              nub . gmiBase . clean
 105
 106 -- really get the imports from a de-litted, cpp'd, de-literal'd string
 107 gmiBase :: String -> [ModImport]
 108 gmiBase s
 109    = f (words s)
 110      where
 111         f ("foreign" : "import" : ws) = f ws
 112         f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
 113            = MISource (mkMN m) : f ws
 114         f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
 115            = MISource (mkMN m) : f ws
 116         f ("import" : "qualified" : m : ws)
 117            = MINormal (mkMN m) : f ws
 118         f ("import" : m : ws)
 119            = MINormal (mkMN m) : f ws
 120         f (w:ws) = f ws
 121         f [] = []
 122
 123         mkMN str = mkModuleName (takeWhile isModId str)
 124         isModId c = isAlphaNum c || c `elem` "'_"
 125
 126 -- remove literals and comments from a string
 127 clean :: String -> String
 128 clean s
 129    = keep s
 130      where
 131         -- running through text we want to keep
 132         keep []                   = []
 133         keep ('"':cs)             = dquote cs           -- "
 134                 -- try to eliminate single quotes when they're part of
 135                 -- an identifier...
 136         keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
 137         keep ('\'':cs)            = squote cs
 138         keep ('-':'-':cs)         = linecomment cs
 139         keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
 140         keep ('{':'-':cs)         = runcomment cs       -- -}
 141         keep (c:cs)               = c : keep cs
 142
 143         -- in a double-quoted string
 144         dquote []             = []
 145         dquote ('\\':'\"':cs) = dquote cs               -- "
 146         dquote ('\\':'\\':cs) = dquote cs
 147         dquote ('\"':cs)      = keep cs                 -- "
 148         dquote (c:cs)         = dquote cs
 149
 150         -- in a single-quoted string
 151         squote []             = []
 152         squote ('\\':'\'':cs) = squote cs
 153         squote ('\\':'\\':cs) = squote cs
 154         squote ('\'':cs)      = keep cs
 155         squote (c:cs)         = squote cs
 156
 157         -- in a line comment
 158         linecomment []        = []
 159         linecomment ('\n':cs) = '\n':keep cs
 160         linecomment (c:cs)    = linecomment cs
 161
 162         -- in a running comment
 163         runcomment []           = []
 164         runcomment ('-':'}':cs) = keep cs
 165         runcomment (c:cs)       = runcomment cs
 166 \end{code}