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 ( ModSummary(..), summarise, name_of_summary,
   8                      getImports {-, source_has_changed-} )
   9 where
  10
  11 #include "HsVersions.h"
  12
  13 import List             ( nub )
  14 import Char             ( isAlphaNum )
  15 --import Time           ( ClockTime )
  16 --import Directory      ( getModificationTime )
  17
  18 import Util             ( unJust )
  19 import HscTypes         ( ModuleLocation(..) )
  20 import Module
  21 import Outputable
  22 \end{code}
  23
  24 \begin{code}
  25
  26
  27 -- The ModuleLocation contains both the original source filename and the
  28 -- filename of the cleaned-up source file after all preprocessing has been
  29 -- done.  The point is that the summariser will have to cpp/unlit/whatever
  30 -- all files anyway, and there's no point in doing this twice -- just
  31 -- park the result in a temp file, put the name of it in the location,
  32 -- and let @compile@ read from that file on the way back up.
  33 data ModSummary
  34    = ModSummary {
  35         ms_mod      :: Module,               -- name, package
  36         ms_location :: ModuleLocation,       -- location
  37         ms_srcimps  :: [ModuleName],         -- source imports
  38         ms_imps     :: [ModuleName]          -- non-source imports
  39         --ms_date     :: Maybe ClockTime       -- timestamp of summarised
  40                                              -- file, if home && source
  41      }
  42
  43 instance Outputable ModSummary where
  44    ppr ms
  45       = sep [--text "ModSummary { ms_date = " <> text (show ms_date),
  46              text "ModSummary {",
  47              nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms) <> comma,
  48                           text "ms_imps =" <+> ppr (ms_imps ms),
  49                           text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
  50              char '}'
  51             ]
  52
  53 name_of_summary :: ModSummary -> ModuleName
  54 name_of_summary = moduleName . ms_mod
  55
  56
  57 -- The first arg is supposed to be DriverPipeline.preprocess.
  58 -- Passed in here to avoid a hard-to-avoid circular dependency
  59 -- between CmSummarise and DriverPipeline.  Same deal as with
  60 -- CmLink.link.
  61 summarise :: (FilePath -> IO FilePath)
  62           -> Module -> ModuleLocation -> IO ModSummary
  63 summarise preprocess mod location
  64    | isModuleInThisPackage mod
  65    = do let hs_fn = unJust (ml_hs_file location) "summarise"
  66         hspp_fn <- preprocess hs_fn
  67         modsrc <- readFile hspp_fn
  68         let (srcimps,imps) = getImports modsrc
  69
  70 --        maybe_timestamp
  71 --           <- case ml_hs_file location of
  72 --                 Nothing     -> return Nothing
  73 --                 Just src_fn -> getModificationTime src_fn >>= Just
  74
  75         return (ModSummary mod location{ml_hspp_file=Just hspp_fn}
  76                                srcimps imps
  77                                 {-maybe_timestamp-} )
  78    | otherwise
  79    = return (ModSummary mod location [] [])
  80
  81 -- Compare the timestamp on the source file with that already
  82 -- in the summary, and see if the source file is younger.  If
  83 -- in any doubt, return True (because False could cause compilation
  84 -- to be omitted).
  85 {-
  86 source_has_changed :: ModSummary -> IO Bool
  87 source_has_changed summary
  88    = case ms_date summary of {
  89         Nothing        -> True;   -- don't appear to have a previous timestamp
  90         Just summ_date ->
  91      case ml_hs_file (ms_loc summary) of {
  92         Nothing        -> True;   -- don't appear to have a source file (?!?!)
  93         Just src_fn -> do now_date <- getModificationTime src_fn
  94                           return (now_date > summ_date)
  95      }}
  96 -}
  97 \end{code}
  98
  99 Collect up the imports from a Haskell source module.  This is
 100 approximate: we don't parse the module, but we do eliminate comments
 101 and strings.  Doesn't currently know how to unlit or cppify the module
 102 first.
 103
 104 \begin{code}
 105 getImports :: String -> ([ModuleName], [ModuleName])
 106 getImports str
 107    = let all_imps = (nub . gmiBase . clean) str
 108          srcs     = concatMap (either unit nil) all_imps
 109          normals  = concatMap (either nil unit) all_imps
 110          unit x   = [x]
 111          nil x    = []
 112      in  (srcs, normals)
 113
 114 -- really get the imports from a de-litted, cpp'd, de-literal'd string
 115 -- Lefts are source imports.  Rights are normal ones.
 116 gmiBase :: String -> [Either ModuleName ModuleName]
 117 gmiBase s
 118    = f (words s)
 119      where
 120         f ("foreign" : "import" : ws) = f ws
 121         f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
 122            = Left (mkMN m) : f ws
 123         f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
 124            = Left (mkMN m) : f ws
 125         f ("import" : "qualified" : m : ws)
 126            = Right (mkMN m) : f ws
 127         f ("import" : m : ws)
 128            = Right (mkMN m) : f ws
 129         f (w:ws) = f ws
 130         f [] = []
 131
 132         mkMN str = mkModuleName (takeWhile isModId str)
 133         isModId c = isAlphaNum c || c `elem` "'_"
 134
 135 -- remove literals and comments from a string
 136 clean :: String -> String
 137 clean s
 138    = keep s
 139      where
 140         -- running through text we want to keep
 141         keep []                   = []
 142         keep ('"':cs)             = dquote cs           -- "
 143                 -- try to eliminate single quotes when they're part of
 144                 -- an identifier...
 145         keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
 146         keep ('\'':cs)            = squote cs
 147         keep ('-':'-':cs)         = linecomment cs
 148         keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
 149         keep ('{':'-':cs)         = runcomment cs       -- -}
 150         keep (c:cs)               = c : keep cs
 151
 152         -- in a double-quoted string
 153         dquote []             = []
 154         dquote ('\\':'\"':cs) = dquote cs               -- "
 155         dquote ('\\':'\\':cs) = dquote cs
 156         dquote ('\"':cs)      = keep cs                 -- "
 157         dquote (c:cs)         = dquote cs
 158
 159         -- in a single-quoted string
 160         squote []             = []
 161         squote ('\\':'\'':cs) = squote cs
 162         squote ('\\':'\\':cs) = squote cs
 163         squote ('\'':cs)      = keep cs
 164         squote (c:cs)         = squote cs
 165
 166         -- in a line comment
 167         linecomment []        = []
 168         linecomment ('\n':cs) = '\n':keep cs
 169         linecomment (c:cs)    = linecomment cs
 170
 171         -- in a running comment
 172         runcomment []           = []
 173         runcomment ('-':'}':cs) = keep cs
 174         runcomment (c:cs)       = runcomment cs
 175 \end{code}