[project @ 2000-10-16 10:05:00 by sewardj]
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
1 %
2 % (c) The University of Glasgow, 2000
3 %
4 \section[HscTypes]{Types for the per-module compiler}
5
6 \begin{code}
7 module HscTypes ( 
8         ModDetails(..), GlobalSymbolTable, 
9
10         TyThing(..), lookupTypeEnv,
11
12         WhetherHasOrphans, ImportVersion, ExportItem,
13         PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
14         IfaceInsts, IfaceRules, DeprecationEnv, OrigNameEnv, AvailEnv,
15
16         InstEnv, 
17
18                 -- Provenance
19         Provenance(..), ImportReason(..), PrintUnqualified,
20         pprProvenance, hasBetterProv
21
22     ) where
23
24 #include "HsVersions.h"
25
26 import Name             ( Name, NameEnv, NamedThing,
27                           unitNameEnv, extendNameEnv, plusNameEnv, 
28                           lookupNameEnv, emptyNameEnv, getName, nameModule )
29 import Module           ( Module, ModuleName,
30                           extendModuleEnv, lookupModuleEnv )
31 import Class            ( Class )
32 import OccName          ( OccName )
33 import RdrName          ( RdrNameEnv, emptyRdrEnv )
34 import Outputable       ( SDoc )
35 import UniqFM           ( UniqFM )
36 import FiniteMap        ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM )
37 import Bag              ( Bag )
38 import Id               ( Id )
39 import VarEnv           ( IdEnv, emptyVarEnv )
40 import BasicTypes       ( Version, Fixity, defaultFixity )
41 import TyCon            ( TyCon )
42 import ErrUtils         ( ErrMsg, WarnMsg )
43 import CmLink           ( Linkable )
44 import RdrHsSyn         ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameHsDecl,
45                           RdrNameDeprecation, RdrNameFixitySig )
46 import UniqSupply       ( UniqSupply )
47 import HsDecls          ( DeprecTxt )
48 import CoreSyn          ( CoreRule )
49 import NameSet          ( NameSet )
50 import Type             ( Type )
51 import VarSet           ( TyVarSet )
52 import Panic            ( panic )
53 \end{code}
54
55 %************************************************************************
56 %*                                                                      *
57 \subsection{Symbol tables and Module details}
58 %*                                                                      *
59 %************************************************************************
60
61 A @ModDetails@ summarises everything we know about a compiled module.
62
63 \begin{code}
64 data ModDetails
65    = ModDetails {
66         md_id       :: Module,
67         md_exports  :: Avails,          -- What it exports
68         md_version  :: VersionInfo,
69         md_globals  :: GlobalRdrEnv,    -- Its top level environment
70
71         md_fixities :: NameEnv Fixity,
72         md_deprecs  :: NameEnv DeprecTxt,
73         md_types    :: TypeEnv,
74
75         md_insts    :: [DFunId],        -- Dfun-ids for the instances in this module
76         md_rules    :: RuleEnv          -- Domain may include Id from other modules
77      }
78
79 emptyModDetails :: Module -> ModDetails
80 emptyModDetails mod
81   = ModDetails { md_id       = mod,
82                  md_exports  = [],
83                  md_globals  = emptyRdrEnv,
84                  md_fixities = emptyNameEnv,
85                  md_deprecs  = emptyNameEnv,
86                  md_types    = emptyNameEnv,
87                  md_insts    = [],
88                  md_rules    = emptyRuleEnv
89     }           
90 \end{code}
91
92 Symbol tables map modules to ModDetails:
93
94 \begin{code}
95 type SymbolTable        = ModuleEnv ModDetails
96 type HomeSymbolTable    = SymbolTable   -- Domain = modules in the home package
97 type PackageSymbolTable = SymbolTable   -- Domain = modules in the some other package
98 type GlobalSymbolTable  = SymbolTable   -- Domain = all modules
99 \end{code}
100
101 Simple lookups in the symbol table.
102
103 \begin{code}
104 lookupFixityEnv :: SymbolTable -> Name -> Maybe Fixity
105         -- Returns defaultFixity if there isn't an explicit fixity
106 lookupFixityEnv tbl name
107   = case lookupModuleEnv tbl (nameModule name) of
108         Nothing      -> Nothing
109         Just details -> lookupNameEnv (md_fixities details) name
110 \end{code}
111
112
113 %************************************************************************
114 %*                                                                      *
115 \subsection{Type environment stuff}
116 %*                                                                      *
117 %************************************************************************
118
119 \begin{code}
120 type TypeEnv = NameEnv TyThing
121
122 data TyThing = AnId   Id
123              | ATyCon TyCon
124              | AClass Class
125
126 instance NamedThing TyThing where
127   getName (AnId id)   = getName id
128   getName (ATyCon tc) = getName tc
129   getName (AClass cl) = getName cl
130 \end{code}
131
132
133 \begin{code}
134 lookupTypeEnv :: SymbolTable -> Name -> Maybe TyThing
135 lookupTypeEnv tbl name
136   = case lookupModuleEnv tbl (nameModule name) of
137         Just details -> lookupNameEnv (md_types details) name
138         Nothing      -> Nothing
139
140
141 groupTyThings :: [TyThing] -> FiniteMap Module TypeEnv
142   -- Finite map because we want the range too
143 groupTyThings things
144   = foldl add emptyFM things
145   where
146     add :: FiniteMap Module TypeEnv -> TyThing -> FiniteMap Module TypeEnv
147     add tbl thing = addToFM tbl mod new_env
148                   where
149                     name    = getName thing
150                     mod     = nameModule name
151                     new_env = case lookupFM tbl mod of
152                                 Nothing  -> unitNameEnv name thing
153                                 Just env -> extendNameEnv env name thing
154                 
155 extendTypeEnv :: SymbolTable -> FiniteMap Module TypeEnv -> SymbolTable
156 extendTypeEnv tbl things
157   = foldFM add tbl things
158   where
159     add mod type_env tbl
160         = panic "extendTypeEnv" --extendModuleEnv mod new_details
161         where
162           new_details 
163              = case lookupModuleEnv tbl mod of
164                   Nothing      -> (emptyModDetails mod) {md_types = type_env}
165                   Just details -> details {md_types = md_types details 
166                                                      `plusNameEnv` type_env}
167 \end{code}
168
169
170 %************************************************************************
171 %*                                                                      *
172 \subsection{Auxiliary types}
173 %*                                                                      *
174 %************************************************************************
175
176 These types are defined here because they are mentioned in ModDetails,
177 but they are mostly elaborated elsewhere
178
179 \begin{code}
180 data VersionInfo 
181   = VersionInfo {
182         modVers :: Version,
183         fixVers :: Version,
184         ruleVers :: Version,
185         declVers :: NameEnv Version
186     }
187
188 type DeprecationEnv = NameEnv DeprecTxt         -- Give reason for deprecation
189
190 type InstEnv    = UniqFM ClsInstEnv             -- Maps Class to instances for that class
191 type ClsInstEnv = [(TyVarSet, [Type], DFunId)]  -- The instances for a particular class
192 type DFunId     = Id
193
194 type RuleEnv    = IdEnv [CoreRule]
195
196 emptyRuleEnv    = emptyVarEnv
197 \end{code}
198
199
200 \begin{code}
201 type Avails       = [AvailInfo]
202 type AvailInfo    = GenAvailInfo Name
203 type RdrAvailInfo = GenAvailInfo OccName
204
205 data GenAvailInfo name  = Avail name     -- An ordinary identifier
206                         | AvailTC name   -- The name of the type or class
207                                   [name] -- The available pieces of type/class.
208                                          -- NB: If the type or class is itself
209                                          -- to be in scope, it must be in this list.
210                                          -- Thus, typically: AvailTC Eq [Eq, ==, /=]
211                         deriving( Eq )
212                         -- Equality used when deciding if the interface has changed
213
214 type AvailEnv     = NameEnv AvailInfo   -- Maps a Name to the AvailInfo that contains it
215 \end{code}
216
217
218 %************************************************************************
219 %*                                                                      *
220 \subsection{ModIface}
221 %*                                                                      *
222 %************************************************************************
223
224 \begin{code}
225 -- ModIFace is nearly the same as RnMonad.ParsedIface.
226 -- Right now it's identical :)
227 data ModIFace 
228    = ModIFace {
229         mi_mod       :: Module,                   -- Complete with package info
230         mi_vers      :: Version,                  -- Module version number
231         mi_orphan    :: WhetherHasOrphans,        -- Whether this module has orphans
232         mi_usages    :: [ImportVersion OccName],  -- Usages
233         mi_exports   :: [ExportItem],             -- Exports
234         mi_insts     :: [RdrNameInstDecl],        -- Local instance declarations
235         mi_decls     :: [(Version, RdrNameHsDecl)],    -- Local definitions
236         mi_fixity    :: (Version, [RdrNameFixitySig]), -- Local fixity declarations, 
237                                                        -- with their version
238         mi_rules     :: (Version, [RdrNameRuleDecl]),  -- Rules, with their version
239         mi_deprecs   :: [RdrNameDeprecation]           -- Deprecations
240      }
241
242 type ExportItem          = (ModuleName, [RdrAvailInfo])
243
244 type ImportVersion name  = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name)
245
246 type ModVersionInfo     = (Version,             -- Version of the whole module
247                            Version,             -- Version number for all fixity decls together
248                            Version)             -- ...ditto all rules together
249
250 type WhetherHasOrphans   = Bool
251         -- An "orphan" is 
252         --      * an instance decl in a module other than the defn module for 
253         --              one of the tycons or classes in the instance head
254         --      * a transformation rule in a module other than the one defining
255         --              the function in the head of the rule.
256
257 type IsBootInterface     = Bool
258
259 data WhatsImported name  = NothingAtAll                         -- The module is below us in the
260                                                                 -- hierarchy, but we import nothing
261
262                          | Everything Version                   -- The module version
263
264                          | Specifically Version                 -- Module version
265                                         Version                 -- Fixity version
266                                         Version                 -- Rules version
267                                         [(name,Version)]        -- List guaranteed non-empty
268                          deriving( Eq )
269         -- 'Specifically' doesn't let you say "I imported f but none of the fixities in
270         -- the module". If you use anything in the module you get its fixity and rule version
271         -- So if the fixities or rules change, you'll recompile, even if you don't use either.
272         -- This is easy to implement, and it's safer: you might not have used the rules last
273         -- time round, but if someone has added a new rule you might need it this time
274
275         -- 'Everything' means there was a "module M" in 
276         -- this module's export list, so we just have to go by M's version,
277         -- not the list of (name,version) pairs
278 \end{code}
279
280
281 %************************************************************************
282 %*                                                                      *
283 \subsection{The persistent compiler state}
284 %*                                                                      *
285 %************************************************************************
286
287 \begin{code}
288 data PersistentCompilerState 
289    = PCS {
290         pcsPST :: PackageSymbolTable,           -- Domain = non-home-package modules
291                                                 --   except that the InstEnv components is empty
292         pcsInsts :: InstEnv,                    -- The total InstEnv accumulated from all
293                                                 --   the non-home-package modules
294         pcsRules :: RuleEnv,                    -- Ditto RuleEnv
295
296         pcsPRS :: PersistentRenamerState
297      }
298 \end{code}
299
300 The @PersistentRenamerState@ persists across successive calls to the
301 compiler.
302
303 It contains:
304   * A name supply, which deals with allocating unique names to
305     (Module,OccName) original names, 
306  
307   * An accumulated InstEnv from all the modules in pcsPST
308     The point is that we don't want to keep recreating it whenever
309     we compile a new module.  The InstEnv component of pcPST is empty.
310     (This means we might "see" instances that we shouldn't "really" see;
311     but the Haskell Report is vague on what is meant to be visible, 
312     so we just take the easy road here.)
313
314   * Ditto for rules
315
316   * A "holding pen" for declarations that have been read out of
317     interface files but not yet sucked in, renamed, and typechecked
318
319 \begin{code}
320 data PersistentRenamerState
321   = PRS { prsOrig  :: OrigNameEnv,
322           prsDecls :: DeclsMap,
323           prsInsts :: IfaceInsts,
324           prsRules :: IfaceRules
325     }
326 \end{code}
327
328 The OrigNameEnv makes sure that there is just one Unique assigned for
329 each original name; i.e. (module-name, occ-name) pair.  The Name is
330 always stored as a Global, and has the SrcLoc of its binding location.
331 Actually that's not quite right.  When we first encounter the original
332 name, we might not be at its binding site (e.g. we are reading an
333 interface file); so we give it 'noSrcLoc' then.  Later, when we find
334 its binding site, we fix it up.
335
336 Exactly the same is true of the Module stored in the Name.  When we first
337 encounter the occurrence, we may not know the details of the module, so
338 we just store junk.  Then when we find the binding site, we fix it up.
339
340 \begin{code}
341 data OrigNameEnv
342  = Orig { origNames  :: FiniteMap (ModuleName,OccName) Name,    -- Ensures that one original name gets one unique
343           origIParam :: FiniteMap OccName Name                  -- Ensures that one implicit parameter name gets one unique
344    }
345 \end{code}
346
347
348 A DeclsMap contains a binding for each Name in the declaration
349 including the constructors of a type decl etc.  The Bool is True just
350 for the 'main' Name.
351
352 \begin{code}
353 type DeclsMap = NameEnv (AvailInfo, Bool, (Module, RdrNameHsDecl))
354
355 type IfaceInsts = Bag GatedDecl
356 type IfaceRules = Bag GatedDecl
357
358 type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
359 \end{code}
360
361
362 %************************************************************************
363 %*                                                                      *
364 \subsection{The result of compiling one module}
365 %*                                                                      *
366 %************************************************************************
367
368 \begin{code}
369 data CompResult
370    = CompOK   ModDetails  -- new details (HST additions)
371               (Maybe (ModIFace, Linkable))
372                        -- summary and code; Nothing => compilation not reqd
373                        -- (old summary and code are still valid)
374               PersistentCompilerState   -- updated PCS
375               (Bag WarnMsg)             -- warnings
376
377    | CompErrs PersistentCompilerState   -- updated PCS
378               (Bag ErrMsg)              -- errors
379               (Bag WarnMsg)             -- warnings
380
381
382 -- The driver sits between 'compile' and 'hscMain', translating calls
383 -- to the former into calls to the latter, and results from the latter
384 -- into results from the former.  It does things like preprocessing
385 -- the .hs file if necessary, and compiling up the .stub_c files to
386 -- generate Linkables.
387
388 data HscResult
389    = HscOK   ModDetails                 -- new details (HomeSymbolTable additions)
390              (Maybe ModIFace)           -- new iface (if any compilation was done)
391              (Maybe String)             -- generated stub_h
392              (Maybe String)             -- generated stub_c
393              PersistentCompilerState    -- updated PCS
394              [SDoc]                     -- warnings
395
396    | HscErrs PersistentCompilerState    -- updated PCS
397              [SDoc]                     -- errors
398              [SDoc]                     -- warnings
399
400         
401 -- These two are only here to avoid recursion between CmCompile and
402 -- CompManager.  They really ought to be in the latter.
403 type ModuleEnv a = UniqFM a   -- Domain is Module
404
405 type HomeModMap         = FiniteMap ModuleName Module -- domain: home mods only
406 type HomeInterfaceTable = ModuleEnv ModIFace
407 \end{code}
408
409
410 %************************************************************************
411 %*                                                                      *
412 \subsection{Provenance and export info}
413 %*                                                                      *
414 %************************************************************************
415
416 The GlobalRdrEnv gives maps RdrNames to Names.  There is a separate
417 one for each module, corresponding to that module's top-level scope.
418
419 \begin{code}
420 type GlobalRdrEnv = RdrNameEnv [(Name,Provenance)]      -- The list is because there may be name clashes
421                                                         -- These only get reported on lookup,
422                                                         -- not on construction
423 \end{code}
424
425 The "provenance" of something says how it came to be in scope.
426
427 \begin{code}
428 data Provenance
429   = LocalDef                    -- Defined locally
430
431   | NonLocalDef                 -- Defined non-locally
432         ImportReason
433         PrintUnqualified
434
435 data ImportReason
436   = UserImport Module SrcLoc Bool       -- Imported from module M on line L
437                                         -- Note the M may well not be the defining module
438                                         -- for this thing!
439         -- The Bool is true iff the thing was named *explicitly* in the import spec,
440         -- rather than being imported as part of a group; e.g.
441         --      import B
442         --      import C( T(..) )
443         -- Here, everything imported by B, and the constructors of T
444         -- are not named explicitly; only T is named explicitly.
445         -- This info is used when warning of unused names.
446
447   | ImplicitImport                      -- Imported implicitly for some other reason
448                         
449
450 type PrintUnqualified = Bool    -- True <=> the unqualified name of this thing is
451                                 -- in scope in this module, so print it 
452                                 -- unqualified in error messages
453 \end{code}
454
455 \begin{code}
456 hasBetterProv :: Provenance -> Provenance -> Bool
457 -- Choose 
458 --      a local thing                 over an   imported thing
459 --      a user-imported thing         over a    non-user-imported thing
460 --      an explicitly-imported thing  over an   implicitly imported thing
461 hasBetterProv LocalDef                              _                              = True
462 hasBetterProv (NonLocalDef (UserImport _ _ True) _) _                              = True
463 hasBetterProv (NonLocalDef (UserImport _ _ _   ) _) (NonLocalDef ImplicitImport _) = True
464 hasBetterProv _                                     _                              = False
465
466 pprNameProvenance :: Name -> Provenance -> SDoc
467 pprProvenance name LocalDef            = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
468 pprProvenance name (NonLocalDef why _) = sep [ppr_reason why, 
469                                               nest 2 (parens (ppr_defn (nameSrcLoc name)))]
470
471 ppr_reason ImplicitImport         = ptext SLIT("implicitly imported")
472 ppr_reason (UserImport mod loc _) = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc
473
474 ppr_defn loc | isGoodSrcLoc loc = ptext SLIT("at") <+> ppr loc
475              | otherwise        = empty
476 \end{code}