2 % (c) The University of Glasgow, 2000
4 \section[CmSummarise]{Module summariser for GHCI}
7 module CmSummarise ( ModImport(..), mi_name,
8 ModSummary(..), summarise, ms_get_imports,
9 name_of_summary, deps_of_summary,
13 #include "HsVersions.h"
16 import Char ( ord, isAlphaNum )
18 import Module ( Module, mod_name, mod_kind,
19 ModuleName, mkModuleName, ModuleKind(..) )
26 -- The Module contains the original source filename of the module.
27 -- The ms_ppsource field contains another filename, which is intended to
28 -- be the cleaned-up source file after all preprocessing has happened to
29 -- it. 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 ms_ppsource,
32 -- and let @compile@ read from that file on the way back up.
35 ms_mod :: Module, -- location and kind
36 ms_ppsource :: (Maybe (FilePath, Fingerprint)), -- preprocessed and sig if .hs
37 ms_imports :: (Maybe [ModImport]) -- imports if .hs or .hi
40 instance Outputable ModSummary where
42 = sep [text "ModSummary {",
43 nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms),
44 text "ms_ppsource =" <+> fooble (ms_ppsource ms),
45 text "ms_imports=" <+> ppr (ms_imports ms)]),
49 fooble Nothing = text "Nothing"
50 fooble (Just (cppd_source_name,fp))
51 = text "(fp =" <+> int fp <> text ","
52 <+> text (show cppd_source_name) <> text ")"
55 = MINormal ModuleName | MISource ModuleName
58 instance Outputable ModImport where
59 ppr (MINormal nm) = ppr nm
60 ppr (MISource nm) = text "{-# SOURCE #-}" <+> ppr nm
63 mi_name (MINormal nm) = nm
64 mi_name (MISource nm) = nm
66 name_of_summary :: ModSummary -> ModuleName
67 name_of_summary = mod_name . ms_mod
69 deps_of_summary :: ModSummary -> [ModuleName]
70 deps_of_summary = map mi_name . ms_get_imports
72 ms_get_imports :: ModSummary -> [ModImport]
74 = case ms_imports summ of { Just is -> is; Nothing -> [] }
76 type Fingerprint = Int
78 summarise :: Module -> IO ModSummary
80 = case mod_kind mod of
81 InPackage path -- if in a package, investigate no further
82 -> return (ModSummary mod Nothing Nothing)
83 SourceOnly path -- source; read, cache and get imports
84 -> readFile path >>= \ modsrc ->
85 let imps = getImports modsrc
86 fp = fingerprint modsrc
87 in return (ModSummary mod (Just (path,fp)) (Just imps))
88 ObjectCode oPath hiPath -- can we get away with the src summariser
89 -- for interface files?
90 -> readFile hiPath >>= \ hisrc ->
91 let imps = getImports hisrc
92 in return (ModSummary mod Nothing (Just imps))
94 fingerprint :: String -> Int
98 -- Copied from hash() in Hugs' storage.c.
99 dofp :: String -> Int# -> Int# -> Int
101 dofp (c:cs) m fp = dofp cs (m +# 1#) (iabs (fp +# m *# unbox (ord c)))
104 iabs n = if n <# 0# then 0# -# n else n
107 Collect up the imports from a Haskell source module. This is
108 approximate: we don't parse the module, but we do eliminate comments
109 and strings. Doesn't currently know how to unlit or cppify the module
114 getImports :: String -> [ModImport]
115 getImports = nub . gmiBase . clean
117 -- really get the imports from a de-litted, cpp'd, de-literal'd string
118 gmiBase :: String -> [ModImport]
122 f ("foreign" : "import" : ws) = f ws
123 f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
124 = MISource (mkMN m) : f ws
125 f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
126 = MISource (mkMN m) : f ws
127 f ("import" : "qualified" : m : ws)
128 = MINormal (mkMN m) : f ws
129 f ("import" : m : ws)
130 = MINormal (mkMN m) : f ws
134 mkMN str = mkModuleName (takeWhile isModId str)
135 isModId c = isAlphaNum c || c `elem` "'_"
137 -- remove literals and comments from a string
138 clean :: String -> String
142 -- running through text we want to keep
144 keep ('"':cs) = dquote cs
145 -- try to eliminate single quotes when they're part of
147 keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
148 keep ('\'':cs) = squote cs
149 keep ('-':'-':cs) = linecomment cs
150 keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
151 keep ('{':'-':cs) = runcomment cs
152 keep (c:cs) = c : keep cs
154 -- in a double-quoted string
156 dquote ('\\':'\"':cs) = dquote cs
157 dquote ('\\':'\\':cs) = dquote cs
158 dquote ('\"':cs) = keep cs
159 dquote (c:cs) = dquote cs
161 -- in a single-quoted string
163 squote ('\\':'\'':cs) = squote cs
164 squote ('\\':'\\':cs) = squote cs
165 squote ('\'':cs) = keep cs
166 squote (c:cs) = squote cs
170 linecomment ('\n':cs) = '\n':keep cs
171 linecomment (c:cs) = linecomment cs
173 -- in a running comment
175 runcomment ('-':'}':cs) = keep cs
176 runcomment (c:cs) = runcomment cs