[project @ 2000-10-30 18:13:15 by sewardj]
[ghc-hetmet.git] / ghc / compiler / ghci / 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             ( ord, isAlphaNum )
17 import Util             ( unJust )
18 import HscTypes         ( ModuleLocation(..) )
19 import FastTypes
20
21 import Module
22 import Outputable
23 \end{code}
24
25 \begin{code}
26
27
28 -- The Module contains the original source filename of the module.
29 -- The ms_ppsource field contains another filename, which is intended to
30 -- be the cleaned-up source file after all preprocessing has happened to
31 -- it.  The point is that the summariser will have to cpp/unlit/whatever
32 -- all files anyway, and there's no point in doing this twice -- just 
33 -- park the result in a temp file, put the name of it in ms_ppsource,
34 -- and let @compile@ read from that file on the way back up.
35 data ModSummary
36    = ModSummary {
37         ms_mod      :: Module,                          -- name, package
38         ms_location :: ModuleLocation,                  -- location
39         ms_ppsource :: (Maybe (FilePath, Fingerprint)), -- preprocessed and sig if .hs
40         ms_imports  :: (Maybe [ModImport])              -- imports if .hs or .hi
41      }
42
43 instance Outputable ModSummary where
44    ppr ms
45       = sep [text "ModSummary {",
46              nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms),
47              text "ms_ppsource =" <+> fooble (ms_ppsource ms),
48              text "ms_imports=" <+> ppr (ms_imports ms)]),
49              char '}'
50             ]
51         where
52            fooble Nothing = text "Nothing"
53            fooble (Just (cppd_source_name,fp)) 
54               = text "(fp =" <+> int fp <> text "," 
55                 <+> text (show cppd_source_name) <> text ")"
56
57 data ModImport
58    = MINormal ModuleName | MISource ModuleName
59      deriving Eq
60
61 instance Outputable ModImport where
62    ppr (MINormal nm) = ppr nm
63    ppr (MISource nm) = text "{-# SOURCE #-}" <+> ppr nm
64
65
66 mimp_name (MINormal nm) = nm
67 mimp_name (MISource nm) = nm
68
69 name_of_summary :: ModSummary -> ModuleName
70 name_of_summary = moduleName . ms_mod
71
72 deps_of_summary :: ModSummary -> [ModuleName]
73 deps_of_summary = map mimp_name . ms_get_imports
74
75 ms_get_imports :: ModSummary -> [ModImport]
76 ms_get_imports summ
77    = case ms_imports summ of { Just is -> is; Nothing -> [] }
78
79 type Fingerprint = Int
80
81 summarise :: Module -> ModuleLocation -> IO ModSummary
82 summarise mod location
83    = if isModuleInThisPackage mod
84         then do 
85             let source_fn = unJust (ml_hspp_file location) "summarise"
86             modsrc <- readFile source_fn
87             let imps = getImports modsrc
88                 fp   = fingerprint modsrc
89             return (ModSummary mod location (Just (source_fn,fp)) (Just imps))
90         else
91            return (ModSummary mod location Nothing Nothing)
92         
93 fingerprint :: String -> Int
94 fingerprint s
95    = dofp s (_ILIT 3) (_ILIT 3)
96      where
97         -- Copied from hash() in Hugs' storage.c.
98         dofp :: String -> FastInt -> FastInt -> Int
99         dofp []     m fp = iBox fp
100         dofp (c:cs) m fp = dofp cs (m +# _ILIT 1) 
101                                 (iabs (fp +# m *# iUnbox (ord c)))
102
103         iabs :: FastInt -> FastInt
104         iabs n = if n <# _ILIT 0 then (_ILIT 0) -# n else n
105 \end{code}
106
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
110 first.
111
112 \begin{code}
113
114 getImports :: String -> [ModImport]
115 getImports = nub . gmiBase . clean
116
117 -- really get the imports from a de-litted, cpp'd, de-literal'd string
118 gmiBase :: String -> [ModImport]
119 gmiBase s
120    = f (words s)
121      where
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
131         f (w:ws) = f ws
132         f [] = []
133
134         mkMN str = mkModuleName (takeWhile isModId str)
135         isModId c = isAlphaNum c || c `elem` "'_"
136
137 -- remove literals and comments from a string
138 clean :: String -> String
139 clean s
140    = keep s
141      where
142         -- running through text we want to keep
143         keep []                   = []
144         keep ('"':cs)             = dquote cs
145                 -- try to eliminate single quotes when they're part of
146                 -- an identifier...
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
153
154         -- in a double-quoted string
155         dquote []             = []
156         dquote ('\\':'\"':cs) = dquote cs
157         dquote ('\\':'\\':cs) = dquote cs
158         dquote ('\"':cs)      = keep cs
159         dquote (c:cs)         = dquote cs
160
161         -- in a single-quoted string
162         squote []             = []
163         squote ('\\':'\'':cs) = squote cs
164         squote ('\\':'\\':cs) = squote cs
165         squote ('\'':cs)      = keep cs
166         squote (c:cs)         = squote cs
167
168         -- in a line comment
169         linecomment []        = []
170         linecomment ('\n':cs) = '\n':keep cs
171         linecomment (c:cs)    = linecomment cs
172
173         -- in a running comment
174         runcomment []           = []
175         runcomment ('-':'}':cs) = keep cs
176         runcomment (c:cs)       = runcomment cs
177 \end{code}