2 % (c) The University of Glasgow, 2000
4 \section[CmSummarise]{Module summariser for GHCI}
7 module CmSummarise ( ModImport(..), mimp_name,
8 ModSummary(..), summarise, ms_get_imports,
9 name_of_summary, deps_of_summary,
13 #include "HsVersions.h"
16 import Char ( ord, isAlphaNum )
17 import HscTypes ( ModuleLocation(..) )
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.
36 ms_mod :: Module, -- name, package
37 ms_location :: ModuleLocation, -- location
38 ms_ppsource :: (Maybe (FilePath, Fingerprint)), -- preprocessed and sig if .hs
39 ms_imports :: (Maybe [ModImport]) -- imports if .hs or .hi
42 instance Outputable ModSummary where
44 = sep [text "ModSummary {",
45 nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms),
46 text "ms_ppsource =" <+> fooble (ms_ppsource ms),
47 text "ms_imports=" <+> ppr (ms_imports ms)]),
51 fooble Nothing = text "Nothing"
52 fooble (Just (cppd_source_name,fp))
53 = text "(fp =" <+> int fp <> text ","
54 <+> text (show cppd_source_name) <> text ")"
57 = MINormal ModuleName | MISource ModuleName
60 instance Outputable ModImport where
61 ppr (MINormal nm) = ppr nm
62 ppr (MISource nm) = text "{-# SOURCE #-}" <+> ppr nm
65 mimp_name (MINormal nm) = nm
66 mimp_name (MISource nm) = nm
68 name_of_summary :: ModSummary -> ModuleName
69 name_of_summary = moduleName . ms_mod
71 deps_of_summary :: ModSummary -> [ModuleName]
72 deps_of_summary = map mimp_name . ms_get_imports
74 ms_get_imports :: ModSummary -> [ModImport]
76 = case ms_imports summ of { Just is -> is; Nothing -> [] }
78 type Fingerprint = Int
80 summarise :: Module -> ModuleLocation -> IO ModSummary
81 summarise mod location
82 = if isModuleInThisPackage mod
84 let source_fn = hs_file location
86 -- ppsource_fn <- preprocess source_fn
87 modsrc <- readFile source_fn
88 let imps = getImports modsrc
89 fp = fingerprint modsrc
90 return (ModSummary mod location (Just (source_fn,fp)) (Just imps))
92 return (ModSummary mod location Nothing Nothing)
94 fingerprint :: String -> Int
96 = dofp s (_ILIT 3) (_ILIT 3)
98 -- Copied from hash() in Hugs' storage.c.
99 dofp :: String -> FastInt -> FastInt -> Int
100 dofp [] m fp = iBox fp
101 dofp (c:cs) m fp = dofp cs (m +# _ILIT 1)
102 (iabs (fp +# m *# iUnbox (ord c)))
104 iabs :: FastInt -> FastInt
105 iabs n = if n <# _ILIT 0 then (_ILIT 0) -# n else n
108 Collect up the imports from a Haskell source module. This is
109 approximate: we don't parse the module, but we do eliminate comments
110 and strings. Doesn't currently know how to unlit or cppify the module
115 getImports :: String -> [ModImport]
116 getImports = nub . gmiBase . clean
118 -- really get the imports from a de-litted, cpp'd, de-literal'd string
119 gmiBase :: String -> [ModImport]
123 f ("foreign" : "import" : ws) = f ws
124 f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
125 = MISource (mkMN m) : f ws
126 f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
127 = MISource (mkMN m) : f ws
128 f ("import" : "qualified" : m : ws)
129 = MINormal (mkMN m) : f ws
130 f ("import" : m : ws)
131 = MINormal (mkMN m) : f ws
135 mkMN str = mkModuleName (takeWhile isModId str)
136 isModId c = isAlphaNum c || c `elem` "'_"
138 -- remove literals and comments from a string
139 clean :: String -> String
143 -- running through text we want to keep
145 keep ('"':cs) = dquote cs
146 -- try to eliminate single quotes when they're part of
148 keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
149 keep ('\'':cs) = squote cs
150 keep ('-':'-':cs) = linecomment cs
151 keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
152 keep ('{':'-':cs) = runcomment cs
153 keep (c:cs) = c : keep cs
155 -- in a double-quoted string
157 dquote ('\\':'\"':cs) = dquote cs
158 dquote ('\\':'\\':cs) = dquote cs
159 dquote ('\"':cs) = keep cs
160 dquote (c:cs) = dquote cs
162 -- in a single-quoted string
164 squote ('\\':'\'':cs) = squote cs
165 squote ('\\':'\\':cs) = squote cs
166 squote ('\'':cs) = keep cs
167 squote (c:cs) = squote cs
171 linecomment ('\n':cs) = '\n':keep cs
172 linecomment (c:cs) = linecomment cs
174 -- in a running comment
176 runcomment ('-':'}':cs) = keep cs
177 runcomment (c:cs) = runcomment cs