MkIface.lhs 38.6 KB
Newer Older
1
2
3
4
5
6
%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%

\begin{code}
module MkIface ( 
7
	pprModIface, showIface, 	-- Print the iface in Foo.hi
8
9
10
11
12
13

	mkUsageInfo, 	-- Construct the usage info for a module

	mkIface, 	-- Build a ModIface from a ModGuts, 
			-- including computing version information

14
15
	writeIfaceFile,	-- Write the interface file

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
	checkOldIface	-- See if recompilation is required, by
			-- comparing version information
 ) where
\end{code}

	-----------------------------------------------
		MkIface.lhs deals with versioning
	-----------------------------------------------

Here's the version-related info in an interface file

  module Foo 8		-- module-version 
	     3		-- export-list-version
	     2		-- rule-version
    Usages: 	-- Version info for what this compilation of Foo imported
	Baz 3		-- Module version
	    [4]		-- The export-list version if Foo depended on it
	    (g,2)	-- Function and its version
	    (T,1)	-- Type and its version

    <version> f :: Int -> Int {- Unfolding: \x -> Wib.t[2] x -}
		-- The [2] says that f's unfolding 
		-- mentions verison 2 of Wib.t
	
	-----------------------------------------------
			Basic idea
	-----------------------------------------------

Basic idea: 
  * In the mi_usages information in an interface, we record the 
    version number of each free variable of the module

  * In mkIface, we compute the version number of each exported thing A.f
    by comparing its A.f's info with its new info, and bumping its 
    version number if it differs.  If A.f mentions B.g, and B.g's version
    number has changed, then we count A.f as having changed too.

  * In checkOldIface we compare the mi_usages for the module with
    the actual version info for all each thing recorded in mi_usages


Fixities
~~~~~~~~
We count A.f as changing if its fixity changes

Rules
~~~~~
If a rule changes, we want to recompile any module that might be
affected by that rule.  For non-orphan rules, this is relatively easy.
If module M defines f, and a rule for f, just arrange that the version
number for M.f changes if any of the rules for M.f change.  Any module
that does not depend on M.f can't be affected by the rule-change
either.

Orphan rules (ones whose 'head function' is not defined in M) are
harder.  Here's what we do.

  * We have a per-module orphan-rule version number which changes if 
    any orphan rule changes. (It's unaffected by non-orphan rules.)

  * We record usage info for any orphan module 'below' this one,
    giving the orphan-rule version number.  We recompile if this 
    changes. 

The net effect is that if an orphan rule changes, we recompile every
module above it.  That's very conservative, but it's devilishly hard
to know what it might affect, so we just have to be conservative.

Instance decls
~~~~~~~~~~~~~~
In an iface file we have
     module A where
	instance Eq a => Eq [a]  =  dfun29
	dfun29 :: ... 

We have a version number for dfun29, covering its unfolding
etc. Suppose we are compiling a module M that imports A only
indirectly.  If typechecking M uses this instance decl, we record the
dependency on A.dfun29 as if it were a free variable of the module
(via the tcg_inst_usages accumulator).  That means that A will appear
in M's usage list.  If the shape of the instance declaration changes,
then so will dfun29's version, triggering a recompilation.

Adding an instance declaration, or changing an instance decl that is
not currently used, is more tricky.  (This really only makes a
difference when we have overlapping instance decls, because then the
new instance decl might kick in to override the old one.)  We handle
this in a very similar way that we handle rules above.

  * For non-orphan instance decls, identify one locally-defined tycon/class
    mentioned in the decl.  Treat the instance decl as part of the defn of that
    tycon/class, so that if the shape of the instance decl changes, so does the
    tycon/class; that in turn will force recompilation of anything that uses
    that tycon/class.

  * For orphan instance decls, act the same way as for orphan rules.
    Indeed, we use the same global orphan-rule version number.

mkUsageInfo
~~~~~~~~~~~
mkUsageInfo figures out what the ``usage information'' for this
moudule is; that is, what it must record in its interface file as the
things it uses.  

We produce a line for every module B below the module, A, currently being
compiled:
	import B <n> ;
to record the fact that A does import B indirectly.  This is used to decide
to look to look for B.hi rather than B.hi-boot when compiling a module that
imports A.  This line says that A imports B, but uses nothing in it.
So we'll get an early bale-out when compiling A if B's version changes.

The usage information records:

\begin{itemize}
\item	(a) anything reachable from its body code
\item	(b) any module exported with a @module Foo@
\item   (c) anything reachable from an exported item
\end{itemize}

Why (b)?  Because if @Foo@ changes then this module's export list
will change, so we must recompile this module at least as far as
making a new interface file --- but in practice that means complete
recompilation.

Why (c)?  Consider this:
\begin{verbatim}
	module A( f, g ) where	|	module B( f ) where
	  import B( f )		|	  f = h 3
	  g = ...		|	  h = ...
\end{verbatim}

Here, @B.f@ isn't used in A.  Should we nevertheless record @B.f@ in
@A@'s usages?  Our idea is that we aren't going to touch A.hi if it is
*identical* to what it was before.  If anything about @B.f@ changes
than anyone who imports @A@ should be recompiled in case they use
@B.f@ (they'll get an early exit if they don't).  So, if anything
about @B.f@ changes we'd better make sure that something in A.hi
changes, and the convenient way to do that is to record the version
number @B.f@ in A.hi in the usage list.  If B.f changes that'll force a
complete recompiation of A, which is overkill but it's the only way to 
write a new, slightly different, A.hi.

But the example is tricker.  Even if @B.f@ doesn't change at all,
@B.h@ may do so, and this change may not be reflected in @f@'s version
number.  But with -O, a module that imports A must be recompiled if
@B.h@ changes!  So A must record a dependency on @B.h@.  So we treat
the occurrence of @B.f@ in the export list *just as if* it were in the
code of A, and thereby haul in all the stuff reachable from it.

	*** Conclusion: if A mentions B.f in its export list,
	    behave just as if A mentioned B.f in its source code,
	    and slurp in B.f and all its transitive closure ***

[NB: If B was compiled with -O, but A isn't, we should really *still*
haul in all the unfoldings for B, in case the module that imports A *is*
compiled with -O.  I think this is the case.]


\begin{code}
#include "HsVersions.h"

import HsSyn
179
import Packages		( isHomeModule, PackageIdH(..) )
180
import IfaceSyn		( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
181
			  IfaceRule(..), IfaceInst(..), IfaceExtName(..), 
182
			  eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool, 
183
			  eqMaybeBy, eqListBy, visibleIfConDecls,
184
185
			  tyThingToIfaceDecl, instanceToIfaceInst, coreRuleToIfaceRule )
import LoadIface	( readIface, loadInterface )
186
187
import BasicTypes	( Version, initialVersion, bumpVersion )
import TcRnMonad
188
import HscTypes		( ModIface(..), ModDetails(..), 
189
			  ModGuts(..), IfaceExport,
190
			  HscEnv(..), hscEPS, Dependencies(..), FixItem(..), 
191
			  ModSummary(..), msHiFilePath, 
192
193
			  mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
			  typeEnvElts, 
194
			  GenAvailInfo(..), availName, 
195
196
197
			  ExternalPackageState(..),
			  Usage(..), IsBootInterface,
			  Deprecs(..), IfaceDeprecs, Deprecations,
198
			  lookupIfaceByModule
199
200
201
			)


202
import Packages		( HomeModules )
203
204
import DynFlags		( GhcMode(..), DynFlags(..), DynFlag(..), dopt )
import StaticFlags	( opt_HiVersion )
205
import Name		( Name, nameModule, nameOccName, nameParent,
206
207
			  isExternalName, isInternalName, nameParent_maybe, isWiredInName,
			  isImplicitName, NamedThing(..) )
208
209
import NameEnv
import NameSet
210
211
import OccName		( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
			  extendOccEnv_C,
212
213
			  OccSet, emptyOccSet, elemOccSet, occSetElts, 
			  extendOccSet, extendOccSetList,
214
215
			  isEmptyOccSet, intersectOccSet, intersectsOccSet,
			  occNameFS, isTcOcc )
216
import Module		( Module, moduleFS,
217
			  ModLocation(..), mkModuleFS, moduleString,
218
			  ModuleEnv, emptyModuleEnv, lookupModuleEnv,
219
			  extendModuleEnv_C
220
221
			)
import Outputable
222
import Util		( createDirectoryHierarchy, directoryOf )
223
import Util		( sortLe, seqList )
224
import Binary		( getBinFileWithDict )
225
import BinIface		( writeBinIface, v_IgnoreHiWay )
226
227
228
import Unique		( Unique, Uniquable(..) )
import ErrUtils		( dumpIfSet_dyn, showPass )
import Digraph		( stronglyConnComp, SCC(..) )
229
import SrcLoc		( SrcSpan )
230
231
232
233
234
import FiniteMap
import FastString

import DATA_IOREF	( writeIORef )
import Monad		( when )
235
import List		( insert )
236
import Maybes		( orElse, mapCatMaybes, isNothing, isJust, 
237
			  expectJust, MaybeErr(..) )
238
239
240
241
242
243
244
245
246
247
248
249
250
\end{code}



%************************************************************************
%*				 					*
\subsection{Completing an interface}
%*				 					*
%************************************************************************

\begin{code}
mkIface :: HscEnv
	-> Maybe ModIface	-- The old interface, if we have it
251
252
	-> ModGuts		-- Usages, deprecations, etc
	-> ModDetails		-- The trimmed, tidied interface
253
254
255
256
257
	-> IO (ModIface, 	-- The new one, complete with decls and versions
	       Bool)		-- True <=> there was an old Iface, and the new one
				--	    is identical, so no need to write it

mkIface hsc_env maybe_old_iface 
258
	(ModGuts{     mg_module  = this_mod,
259
260
261
		      mg_boot    = is_boot,
		      mg_usages  = usages,
		      mg_deps    = deps,
262
		      mg_home_mods = home_mods,
263
		      mg_rdr_env = rdr_env,
264
		      mg_fix_env = fix_env,
265
266
267
268
269
270
		      mg_deprecs = src_deprecs })
	(ModDetails{  md_insts 	 = insts, 
		      md_rules 	 = rules,
		      md_types 	 = type_env,
		      md_exports = exports })
	
271
272
273
274
275
-- NB:	notice that mkIface does not look at the bindings
--	only at the TypeEnv.  The previous Tidy phase has
--	put exactly the info into the TypeEnv that we want
--	to expose in the interface

276
  = do	{ eps <- hscEPS hsc_env
277
	; let	{ ext_nm_rhs = mkExtNameFn hsc_env home_mods eps this_mod
278
		; ext_nm_lhs = mkLhsNameFn this_mod
279
280
281
282
283
284
285
286
287
288

		; decls  = [ tyThingToIfaceDecl ext_nm_rhs thing 
			   | thing <- typeEnvElts type_env, 
			     not (isImplicitName (getName thing)) ]
		    	-- Don't put implicit Ids and class tycons in the interface file

		; fixities    = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
		; deprecs     = mkIfaceDeprec src_deprecs
		; iface_rules = map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules
		; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
289
290
291

	        ; intermediate_iface = ModIface { 
			mi_module   = this_mod,
292
			mi_package  = HomePackage,
293
			mi_boot     = is_boot,
294
295
			mi_deps     = deps,
			mi_usages   = usages,
296
			mi_exports  = mkIfaceExports exports,
297
298
			mi_insts    = sortLe le_inst iface_insts,
			mi_rules    = sortLe le_rule iface_rules,
299
300
			mi_fixities = fixities,
			mi_deprecs  = deprecs,
301
302
			mi_globals  = Just rdr_env,

303
304
305
306
307
308
309
310
311
312
313
314
315
316
			-- Left out deliberately: filled in by addVersionInfo
			mi_mod_vers  = initialVersion,
 			mi_exp_vers  = initialVersion,
 			mi_rule_vers = initialVersion,
			mi_orphan    = False,	-- Always set by addVersionInfo, but
						-- it's a strict field, so we can't omit it.
			mi_decls     = deliberatelyOmitted "decls",
			mi_ver_fn    = deliberatelyOmitted "ver_fn",

			-- And build the cached values
			mi_dep_fn = mkIfaceDepCache deprecs,
			mi_fix_fn = mkIfaceFixCache fixities }

		-- Add version information
317
		; (new_iface, no_change_at_all, pp_diffs, pp_orphs) 
318
319
320
321
322
			= _scc_ "versioninfo" 
			 addVersionInfo maybe_old_iface intermediate_iface decls
		}

		-- Debug printing
323
	; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags) 
324
	       (printDump (expectJust "mkIface" pp_orphs))
325
	; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
326
327
328
	; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE" 
			(pprModIface new_iface)

329
	; return (new_iface, no_change_at_all) }
330
  where
331
332
     r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
     i1 `le_inst` i2 = ifDFun     i1 <= ifDFun     i2
333

334
335
     dflags = hsc_dflags hsc_env
     deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
336
337

					      
338
-----------------------------
339
340
341
342
343
writeIfaceFile :: ModLocation -> ModIface -> IO ()
writeIfaceFile location new_iface
    = do createDirectoryHierarchy (directoryOf hi_file_path)
         writeBinIface hi_file_path new_iface
    where hi_file_path = ml_hi_file location
344
345
346


-----------------------------
347
348
mkExtNameFn :: HscEnv -> HomeModules -> ExternalPackageState -> Module -> Name -> IfaceExtName
mkExtNameFn hsc_env hmods eps this_mod
349
350
351
352
353
354
  = ext_nm
  where
    hpt = hsc_HPT hsc_env
    pit = eps_PIT eps

    ext_nm name 
355
      | mod == this_mod = case nameParent_maybe name of
356
357
    				Nothing  -> LocalTop occ
    				Just par -> LocalTopSub occ (nameOccName par)
358
      | isWiredInName name       = ExtPkg  mod occ
359
      | isHomeModule hmods mod   = HomePkg mod occ vers
360
      | otherwise	         = ExtPkg  mod occ
361
362
363
364
365
      where
    	mod      = nameModule name
    	occ	 = nameOccName name
    	par_occ  = nameOccName (nameParent name)
    		-- The version of the *parent* is the one want
366
    	vers     = lookupVersion mod par_occ
367
    	      
368
    lookupVersion :: Module -> OccName -> Version
369
370
371
372
373
374
	-- Even though we're looking up a home-package thing, in
	-- one-shot mode the imported interfaces may be in the PIT
    lookupVersion mod occ
      = mi_ver_fn iface occ `orElse` 
        pprPanic "lookupVers1" (ppr mod <+> ppr occ)
      where
375
        iface = lookupIfaceByModule hpt pit mod `orElse` 
376
377
	        pprPanic "lookupVers2" (ppr mod <+> ppr occ)

378
379
380
381
382
383
384

---------------------
-- mkLhsNameFn ignores versioning info altogether
-- It is used for the LHS of instance decls and rules, where we 
-- there's no point in recording version info
mkLhsNameFn :: Module -> Name -> IfaceExtName
mkLhsNameFn this_mod name	
385
386
  | isInternalName name = pprTrace "mkLhsNameFn: unexpected internal" (ppr name) $
			  LocalTop occ	-- Should not happen
387
388
389
390
391
392
393
  | mod == this_mod = LocalTop occ
  | otherwise	    = ExtPkg mod occ
  where
    mod = nameModule name
    occ	= nameOccName name


394
395
396
397
398
399
400
401
-----------------------------
-- Compute version numbers for local decls

addVersionInfo :: Maybe ModIface	-- The old interface, read from M.hi
	       -> ModIface		-- The new interface decls (lacking decls)
	       -> [IfaceDecl]		-- The new decls
	       -> (ModIface, 
		   Bool,		-- True <=> no changes at all; no need to write new Iface
402
403
		   SDoc,		-- Differences
		   Maybe SDoc)		-- Warnings about orphans
404
405
406

addVersionInfo Nothing new_iface new_decls
-- No old interface, so definitely write a new one!
407
408
  = (new_iface { mi_orphan = anyNothing ifInstOrph (mi_insts new_iface)
			  || anyNothing ifRuleOrph (mi_rules new_iface),
409
410
		 mi_decls  = [(initialVersion, decl) | decl <- new_decls],
		 mi_ver_fn = \n -> Just initialVersion },
411
412
413
     False, 
     ptext SLIT("No old interface file"),
     pprOrphans orph_insts orph_rules)
414
  where
415
416
    orph_insts = filter (isNothing . ifInstOrph) (mi_insts new_iface)
    orph_rules = filter (isNothing . ifRuleOrph) (mi_rules new_iface)
417
418
419
420
421
422
423
424
425
426

addVersionInfo (Just old_iface@(ModIface { mi_mod_vers  = old_mod_vers, 
					   mi_exp_vers  = old_exp_vers, 
					   mi_rule_vers = old_rule_vers, 
				       	   mi_decls     = old_decls,
					   mi_ver_fn    = old_decl_vers,
				       	   mi_fix_fn    = old_fixities }))
	       new_iface@(ModIface { mi_fix_fn = new_fixities })
	       new_decls

427
  | no_change_at_all = (old_iface,   True,  ptext SLIT("Interface file unchanged"), pp_orphs)
428
  | otherwise	     = (final_iface, False, vcat [ptext SLIT("Interface file has changed"),
429
						  nest 2 pp_diffs], pp_orphs)
430
431
432
433
434
435
436
437
438
439
440
  where
    final_iface = new_iface { mi_mod_vers  = bump_unless no_output_change old_mod_vers,
			      mi_exp_vers  = bump_unless no_export_change old_exp_vers,
			      mi_rule_vers = bump_unless no_rule_change   old_rule_vers,
			      mi_orphan    = not (null new_orph_rules && null new_orph_insts),
			      mi_decls     = decls_w_vers,
			      mi_ver_fn    = mkIfaceVerCache decls_w_vers }

    decls_w_vers = [(add_vers decl, decl) | decl <- new_decls]

    -------------------
441
442
    (old_non_orph_insts, old_orph_insts) = mkOrphMap ifInstOrph (mi_insts old_iface)
    (new_non_orph_insts, new_orph_insts) = mkOrphMap ifInstOrph (mi_insts new_iface)
443
444
445
446
    same_insts occ = eqMaybeBy	(eqListBy eqIfInst) 
				(lookupOccEnv old_non_orph_insts occ)
				(lookupOccEnv new_non_orph_insts occ)
  
447
448
    (old_non_orph_rules, old_orph_rules) = mkOrphMap ifRuleOrph (mi_rules old_iface)
    (new_non_orph_rules, new_orph_rules) = mkOrphMap ifRuleOrph (mi_rules new_iface)
449
450
451
452
453
454
455
456
457
458
459
460
461
462
    same_rules occ = eqMaybeBy	(eqListBy eqIfRule)
				(lookupOccEnv old_non_orph_rules occ)
				(lookupOccEnv new_non_orph_rules occ)
    -------------------
    -- Computing what changed
    no_output_change = no_decl_change   && no_rule_change && 
    		       no_export_change && no_deprec_change
    no_export_change = mi_exports new_iface == mi_exports old_iface	-- Kept sorted
    no_decl_change   = isEmptyOccSet changed_occs
    no_rule_change   = not (changedWrt changed_occs (eqListBy eqIfRule old_orph_rules new_orph_rules)
	    		 || changedWrt changed_occs (eqListBy eqIfInst old_orph_insts new_orph_insts))
    no_deprec_change = mi_deprecs new_iface == mi_deprecs old_iface

	-- If the usages havn't changed either, we don't need to write the interface file
463
464
    no_other_changes = mi_usages new_iface == mi_usages old_iface && 
		       mi_deps new_iface == mi_deps old_iface
465
466
    no_change_at_all = no_output_change && no_other_changes
 
467
    pp_diffs = vcat [pp_change no_export_change "Export list" 
468
469
470
471
			(ppr old_exp_vers <+> arrow <+> ppr (mi_exp_vers final_iface)),
 		     pp_change no_rule_change "Rules"
			(ppr old_rule_vers <+> arrow <+> ppr (mi_rule_vers final_iface)),
 		     pp_change no_deprec_change "Deprecations" empty,
472
473
 		     pp_change no_other_changes  "Usages" empty,
		     pp_decl_diffs]
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
    pp_change True  what info = empty
    pp_change False what info = text what <+> ptext SLIT("changed") <+> info

    -------------------
    old_decl_env = mkOccEnv [(ifName decl, decl) | (_,decl) <- old_decls]
    same_fixity n = bool (old_fixities n == new_fixities n)

    -------------------
    -- Adding version info
    new_version     = bumpVersion old_mod_vers
    add_vers decl | occ `elemOccSet` changed_occs = new_version
		  | otherwise = expectJust "add_vers" (old_decl_vers occ)
				-- If it's unchanged, there jolly well 
		  where		-- should be an old version number
		    occ = ifName decl

    -------------------
    changed_occs :: OccSet
    changed_occs = computeChangedOccs eq_info

    eq_info :: [(OccName, IfaceEq)]
    eq_info = map check_eq new_decls
    check_eq new_decl | Just old_decl <- lookupOccEnv old_decl_env occ 
		      = (occ, new_decl `eqIfDecl` old_decl &&&
			      eq_indirects new_decl)
		      | otherwise {- No corresponding old decl -}      
		      = (occ, NotEqual)	
		      where
			occ = ifName new_decl

    eq_indirects :: IfaceDecl -> IfaceEq
		-- When seeing if two decls are the same, remember to
		-- check whether any relevant fixity or rules have changed
    eq_indirects (IfaceId {ifName = occ}) = eq_ind_occ occ
    eq_indirects (IfaceClass {ifName = cls_occ, ifSigs = sigs})
	= same_insts cls_occ &&& 
	  eq_ind_occs [op | IfaceClassOp op _ _ <- sigs] 
    eq_indirects (IfaceData {ifName = tc_occ, ifCons = cons})
	= same_insts tc_occ &&& same_fixity tc_occ &&&	-- The TyCon can have a fixity too
513
	  eq_ind_occs (map ifConOcc (visibleIfConDecls cons))
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
    eq_indirects other = Equal	-- Synonyms and foreign declarations

    eq_ind_occ :: OccName -> IfaceEq	-- For class ops and Ids; check fixity and rules
    eq_ind_occ occ = same_fixity occ &&& same_rules occ
    eq_ind_occs = foldr ((&&&) . eq_ind_occ) Equal 
   
    -------------------
    -- Diffs
    pp_decl_diffs :: SDoc	-- Nothing => no changes
    pp_decl_diffs 
	| isEmptyOccSet changed_occs = empty
	| otherwise 
	= vcat [ptext SLIT("Changed occs:") <+> ppr (occSetElts changed_occs),
		ptext SLIT("Version change for these decls:"),
		nest 2 (vcat (map show_change new_decls))]

    eq_env = mkOccEnv eq_info
    show_change new_decl
	| not (occ `elemOccSet` changed_occs) = empty
	| otherwise
	= vcat [ppr occ <+> ppr (old_decl_vers occ) <+> arrow <+> ppr new_version, 
		nest 2 why]
	where
	  occ = ifName new_decl
	  why = case lookupOccEnv eq_env occ of
		    Just (EqBut occs) -> sep [ppr occ <> colon, ptext SLIT("Free vars (only) changed:"),
					      nest 2 (braces (fsep (map ppr (occSetElts 
						(occs `intersectOccSet` changed_occs)))))]
		    Just NotEqual  
			| Just old_decl <- lookupOccEnv old_decl_env occ 
			-> vcat [ptext SLIT("Old:") <+> ppr old_decl,
			 ptext SLIT("New:") <+> ppr new_decl]
			| otherwise 
			-> ppr occ <+> ptext SLIT("only in new interface")
		    other -> pprPanic "MkIface.show_change" (ppr occ)
	
550
551
552
    pp_orphs = pprOrphans new_orph_insts new_orph_rules

pprOrphans insts rules
553
554
555
556
557
558
559
560
561
562
  | null insts && null rules = Nothing
  | otherwise
  = Just $ vcat [
	if null insts then empty else
	     hang (ptext SLIT("Warning: orphan instances:"))
		2 (vcat (map ppr insts)),
	if null rules then empty else
	     hang (ptext SLIT("Warning: orphan rules:"))
		2 (vcat (map ppr rules))
    ]
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590

computeChangedOccs :: [(OccName, IfaceEq)] -> OccSet
computeChangedOccs eq_info
  = foldl add_changes emptyOccSet (stronglyConnComp edges)
  where
    edges :: [((OccName,IfaceEq), Unique, [Unique])]
    edges = [ (node, getUnique occ, map getUnique occs)
	    | node@(occ, iface_eq) <- eq_info
	    , let occs = case iface_eq of
			   EqBut occ_set -> occSetElts occ_set
			   other -> [] ]

    -- Changes in declarations
    add_changes :: OccSet -> SCC (OccName, IfaceEq) -> OccSet
    add_changes so_far (AcyclicSCC (occ, iface_eq)) 
	| changedWrt so_far iface_eq 				-- This one has changed
	= extendOccSet so_far occ
    add_changes so_far (CyclicSCC pairs)
	| changedWrt so_far (foldr1 (&&&) (map snd pairs)) 	-- One of this group has changed
	= extendOccSetList so_far (map fst pairs)
    add_changes so_far other = so_far

changedWrt :: OccSet -> IfaceEq -> Bool
changedWrt so_far Equal        = False
changedWrt so_far NotEqual     = True
changedWrt so_far (EqBut kids) = so_far `intersectsOccSet` kids

----------------------
591
-- mkOrphMap partitions instance decls or rules into
592
593
594
-- 	(a) an OccEnv for ones that are not orphans, 
--	    mapping the local OccName to a list of its decls
--	(b) a list of orphan decls
595
mkOrphMap :: (decl -> Maybe OccName)	-- (Just occ) for a non-orphan decl, keyed by occ
596
597
598
599
600
					-- Nothing for an orphan decl
	  -> [decl] 			-- Sorted into canonical order
	  -> (OccEnv [decl],	 	-- Non-orphan decls associated with their key;
					--	each sublist in canonical order
	      [decl])			-- Orphan decls; in canonical order
601
mkOrphMap get_key decls
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
  = foldl go (emptyOccEnv, []) decls
  where
    go (non_orphs, orphs) d
	| Just occ <- get_key d
	= (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
	| otherwise = (non_orphs, d:orphs)

anyNothing :: (a -> Maybe b) -> [a] -> Bool
anyNothing p []     = False
anyNothing p (x:xs) = isNothing (p x) || anyNothing p xs

----------------------
mkIfaceDeprec :: Deprecations -> IfaceDeprecs
mkIfaceDeprec NoDeprecs        = NoDeprecs
mkIfaceDeprec (DeprecAll t)    = DeprecAll t
617
mkIfaceDeprec (DeprecSome env) = DeprecSome (sortLe (<=) (nameEnvElts env))
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633

----------------------
bump_unless :: Bool -> Version -> Version
bump_unless True  v = v	-- True <=> no change
bump_unless False v = bumpVersion v
\end{code}


%*********************************************************
%*							*
\subsection{Keeping track of what we've slurped, and version numbers}
%*							*
%*********************************************************


\begin{code}
634
mkUsageInfo :: HscEnv 
635
	    -> HomeModules
636
	    -> ModuleEnv (Module, Bool, SrcSpan)
637
	    -> [(Module, IsBootInterface)]
638
	    -> NameSet -> IO [Usage]
639
mkUsageInfo hsc_env hmods dir_imp_mods dep_mods used_names
640
  = do	{ eps <- hscEPS hsc_env
641
	; let usages = mk_usage_info (eps_PIT eps) hsc_env hmods
642
643
644
645
646
				     dir_imp_mods dep_mods used_names
	; usages `seqList`  return usages }
	 -- seq the list of Usages returned: occasionally these
	 -- don't get evaluated for a while and we can end up hanging on to
	 -- the entire collection of Ifaces.
647

648
mk_usage_info pit hsc_env hmods dir_imp_mods dep_mods proto_used_names
649
650
  = mapCatMaybes mkUsage dep_mods
	-- ToDo: do we need to sort into canonical order?
651
  where
652
653
    hpt = hsc_HPT hsc_env

654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
    used_names = mkNameSet $			-- Eliminate duplicates
		 [ nameParent n			-- Just record usage on the 'main' names
		 | n <- nameSetToList proto_used_names
		 , not (isWiredInName n)	-- Don't record usages for wired-in names
		 , isExternalName n		-- Ignore internal names
		 ]

    -- ent_map groups together all the things imported and used
    -- from a particular module in this package
    ent_map :: ModuleEnv [OccName]
    ent_map  = foldNameSet add_mv emptyModuleEnv used_names
    add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [occ]
    		   where
		     occ = nameOccName name
    		     mod = nameModule name
    		     add_item occs _ = occ:occs
    
671
672
673
    depend_on_exports mod = case lookupModuleEnv dir_imp_mods mod of
    				Just (_,no_imp,_) -> not no_imp
	    			Nothing		  -> True
674
675
676
677
678
679
680
    
    -- We want to create a Usage for a home module if 
    --	a) we used something from; has something in used_names
    --	b) we imported all of it, even if we used nothing from it
    --		(need to recompile if its export list changes: export_vers)
    --	c) is a home-package orphan module (need to recompile if its
    --	 	instance decls change: rules_vers)
681
    mkUsage :: (Module, Bool) -> Maybe Usage
682
683
    mkUsage (mod_name, _)
      |  isNothing maybe_iface	-- We can't depend on it if we didn't
684
      || not (isHomeModule hmods mod)	-- even open the interface!
685
      || (null used_occs
686
	  && isNothing export_vers
687
688
689
690
	  && not orphan_mod)
      = Nothing			-- Record no usage info
    
      | otherwise	
691
      = Just (Usage { usg_name     = mod,
692
693
694
695
696
    	  	      usg_mod      = mod_vers,
    		      usg_exports  = export_vers,
    		      usg_entities = ent_vers,
    		      usg_rules    = rules_vers })
      where
697
	maybe_iface  = lookupIfaceByModule hpt pit mod_name
698
699
700
701
702
703
704
705
706
		-- In one-shot mode, the interfaces for home-package 
		-- modules accumulate in the PIT not HPT.  Sigh.

        Just iface   = maybe_iface
        mod   	     = mi_module    iface
	orphan_mod   = mi_orphan    iface
        version_env  = mi_ver_fn    iface
        mod_vers     = mi_mod_vers  iface
        rules_vers   = mi_rule_vers iface
707
708
        export_vers | depend_on_exports mod = Just (mi_exp_vers iface)
    		    | otherwise 	    = Nothing
709
710
711
712
713
    
    	-- The sort is to put them into canonical order
        used_occs = lookupModuleEnv ent_map mod `orElse` []
	ent_vers :: [(OccName,Version)]
        ent_vers = [ (occ, version_env occ `orElse` initialVersion) 
714
		   | occ <- sortLe (<=) used_occs]
715
716
717
\end{code}

\begin{code}
718
mkIfaceExports :: NameSet -> [(Module, [GenAvailInfo OccName])]
719
720
  -- Group by module and sort by occurrence
  -- This keeps the list in canonical order
721
mkIfaceExports exports 
722
  = [ (mkModuleFS fs, eltsFM avails)
723
    | (fs, avails) <- fmToList groupFM
724
725
    ]
  where
726
    groupFM :: FiniteMap FastString (FiniteMap FastString (GenAvailInfo OccName))
727
728
	-- Deliberately use the FastString so we
	-- get a canonical ordering
729
730
731
732
733
734
    groupFM = foldl add emptyFM (nameSetToList exports)

    add env name = addToFM_C add_avail env mod_fs 
			     (unitFM avail_fs avail)
      where
	occ    = nameOccName name
735
	mod_fs = moduleFS (nameModule name)
736
	avail | Just p <- nameParent_maybe name	= AvailTC (nameOccName p) [occ]
737
738
739
740
741
	      | isTcOcc occ 			= AvailTC occ [occ]
	      | otherwise			= Avail occ
	avail_fs = occNameFS (availName avail)	    
	add_avail avail_fm _ = addToFM_C add_item avail_fm avail_fs avail

742
743
	add_item (AvailTC p occs) _ = AvailTC p (List.insert occ occs)
	add_item (Avail n)	  _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name)
744
745
\end{code}

746

747
748
749
750
751
752
753
754
755
756
%************************************************************************
%*									*
	Load the old interface file for this module (unless
	we have it aleady), and check whether it is up to date
	
%*									*
%************************************************************************

\begin{code}
checkOldIface :: HscEnv
757
	      -> ModSummary
758
759
760
761
	      -> Bool 			-- Source unchanged
	      -> Maybe ModIface 	-- Old interface from compilation manager, if any
	      -> IO (RecompileRequired, Maybe ModIface)

762
checkOldIface hsc_env mod_summary source_unchanged maybe_iface
763
  = do	{ showPass (hsc_dflags hsc_env) 
764
	           ("Checking old interface for " ++ moduleString (ms_mod mod_summary)) ;
765

766
	; initIfaceCheck hsc_env $
767
	  check_old_iface mod_summary source_unchanged maybe_iface
768
769
     }

770
check_old_iface mod_summary source_unchanged maybe_iface
771
772
773
774
775
776
777
 = 	-- CHECK WHETHER THE SOURCE HAS CHANGED
    ifM (not source_unchanged)
	(traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
					      	`thenM_`

     -- If the source has changed and we're in interactive mode, avoid reading
     -- an interface; just return the one we might have been supplied with.
778
779
    getGhcMode					`thenM` \ ghc_mode ->
    if (ghc_mode == Interactive || ghc_mode == JustTypecheck) 
780
	&& not source_unchanged then
781
782
783
784
785
786
787
788
789
790
791
792
         returnM (outOfDate, maybe_iface)
    else

    case maybe_iface of {
       Just old_iface -> -- Use the one we already have
                         checkVersions source_unchanged old_iface	`thenM` \ recomp ->
			 returnM (recomp, Just old_iface)

    ;  Nothing ->

	-- Try and read the old interface for the current module
	-- from the .hi file left from the last time we compiled it
793
794
795
796
    let
	iface_path = msHiFilePath mod_summary
    in
    readIface (ms_mod mod_summary) iface_path False	`thenM` \ read_result ->
797
    case read_result of {
798
       Failed err ->	-- Old interface file not found, or garbled; give up
799
		   traceIf (text "FYI: cannot read old interface file:"
800
801
802
			   	 $$ nest 4 err) 	`thenM_`
	           returnM (outOfDate, Nothing)

803
    ;  Succeeded iface ->	
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827

	-- We have got the old iface; check its versions
    checkVersions source_unchanged iface	`thenM` \ recomp ->
    returnM (recomp, Just iface)
    }}
\end{code}

@recompileRequired@ is called from the HscMain.   It checks whether
a recompilation is required.  It needs access to the persistent state,
finder, etc, because it may have to load lots of interface files to
check their versions.

\begin{code}
type RecompileRequired = Bool
upToDate  = False	-- Recompile not required
outOfDate = True	-- Recompile required

checkVersions :: Bool		-- True <=> source unchanged
	      -> ModIface 	-- Old interface
	      -> IfG RecompileRequired
checkVersions source_unchanged iface
  | not source_unchanged
  = returnM outOfDate
  | otherwise
828
829
  = do	{ traceHiDiffs (text "Considering whether compilation is required for" <+> 
		        ppr (mi_module iface) <> colon)
830
831

	-- Source code unchanged and no errors yet... carry on 
832

833
	-- First put the dependent-module info, read from the old interface, into the envt, 
834
	-- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
835
	-- 
836
837
838
	-- It's just temporary because either the usage check will succeed 
	-- (in which case we are done with this module) or it'll fail (in which
	-- case we'll compile the module from scratch anyhow).
839
840
841
	--	
	-- We do this regardless of compilation mode
	; updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
842
843
844

	; checkList [checkModUsage u | u <- mi_usages iface]
    }
845
846
  where
	-- This is a bit of a hack really
847
    mod_deps :: ModuleEnv (Module, IsBootInterface)
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
    mod_deps = mkModDeps (dep_mods (mi_deps iface))

checkModUsage :: Usage -> IfG RecompileRequired
-- Given the usage information extracted from the old
-- M.hi file for the module being compiled, figure out
-- whether M needs to be recompiled.

checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
		       usg_rules = old_rule_vers,
		       usg_exports = maybe_old_export_vers, 
		       usg_entities = old_decl_vers })
  = 	-- Load the imported interface is possible
    let
    	doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
    in
    traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`

    loadInterface doc_str mod_name ImportBySystem	`thenM` \ mb_iface ->
	-- Load the interface, but don't complain on failure;
	-- Instead, get an Either back which we can test

    case mb_iface of {
870
	Failed exn ->  (out_of_date (sep [ptext SLIT("Can't find version number for module"), 
871
872
873
874
875
				       ppr mod_name]));
		-- Couldn't find or parse a module mentioned in the
		-- old interface file.  Don't complain -- it might just be that
		-- the current module doesn't need that import and it's been deleted

876
	Succeeded iface -> 
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
    let
	new_mod_vers    = mi_mod_vers  iface
	new_decl_vers 	= mi_ver_fn    iface
	new_export_vers = mi_exp_vers  iface
	new_rule_vers   = mi_rule_vers iface
    in
	-- CHECK MODULE
    checkModuleVersion old_mod_vers new_mod_vers	`thenM` \ recompile ->
    if not recompile then
	returnM upToDate
    else
				 
	-- CHECK EXPORT LIST
    if checkExportList maybe_old_export_vers new_export_vers then
	out_of_date_vers (ptext SLIT("  Export list changed"))
892
		         (expectJust "checkModUsage" maybe_old_export_vers) 
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
		         new_export_vers
    else

	-- CHECK RULES
    if old_rule_vers /= new_rule_vers then
	out_of_date_vers (ptext SLIT("  Rules changed")) 
			 old_rule_vers new_rule_vers
    else

	-- CHECK ITEMS ONE BY ONE
    checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers]	`thenM` \ recompile ->
    if recompile then
	returnM outOfDate	-- This one failed, so just bail out now
    else
	up_to_date (ptext SLIT("  Great!  The bits I use are up to date"))
    }

------------------------
checkModuleVersion old_mod_vers new_mod_vers
  | new_mod_vers == old_mod_vers
  = up_to_date (ptext SLIT("Module version unchanged"))

  | otherwise
  = out_of_date_vers (ptext SLIT("  Module version has changed"))
		     old_mod_vers new_mod_vers

------------------------
checkExportList Nothing  new_vers = upToDate
checkExportList (Just v) new_vers = v /= new_vers

------------------------
checkEntityUsage new_vers (name,old_vers)
  = case new_vers name of

	Nothing       -> 	-- We used it before, but it ain't there now
			  out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])

	Just new_vers 	-- It's there, but is it up to date?
	  | new_vers == old_vers -> traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_`
			  	    returnM upToDate
	  | otherwise	 	 -> out_of_date_vers (ptext SLIT("  Out of date:") <+> ppr name)
						     old_vers new_vers

up_to_date  msg = traceHiDiffs msg `thenM_` returnM upToDate
out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate
out_of_date_vers msg old_vers new_vers 
  = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers])

----------------------
checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
-- This helper is used in two places
checkList []		 = returnM upToDate
checkList (check:checks) = check	`thenM` \ recompile ->
			   if recompile then 
				returnM outOfDate
			   else
				checkList checks
\end{code}

%************************************************************************
%*				 					*
		Printing interfaces
%*				 					*
%************************************************************************

\begin{code}
showIface :: FilePath -> IO ()
dons's avatar
dons committed
960
-- Read binary interface, and print it out
961
962
963
showIface filename = do
   -- skip the version check; we don't want to worry about profiled vs.
   -- non-profiled interfaces, for example.
964
   writeIORef v_IgnoreHiWay True
965
966
967
968
969
970
971
972
973
974
975
   iface <- Binary.getBinFileWithDict filename
   printDump (pprModIface iface)
 where
\end{code}


\begin{code}
pprModIface :: ModIface -> SDoc
-- Show a ModIface
pprModIface iface
 = vcat [ ptext SLIT("interface")
976
		<+> ppr_package (mi_package iface)
977
978
		<+> ppr (mi_module iface) <+> pp_boot 
		<+> ppr (mi_mod_vers iface) <+> pp_sub_vers
979
		<+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
980
981
982
983
984
985
986
987
988
989
990
991
		<+> int opt_HiVersion
		<+> ptext SLIT("where")
	, vcat (map pprExport (mi_exports iface))
	, pprDeps (mi_deps iface)
	, vcat (map pprUsage (mi_usages iface))
	, pprFixities (mi_fixities iface)
	, vcat (map pprIfaceDecl (mi_decls iface))
	, vcat (map ppr (mi_insts iface))
	, vcat (map ppr (mi_rules iface))
	, pprDeprecs (mi_deprecs iface)
	]
  where
992
993
    pp_boot | mi_boot iface = ptext SLIT("[boot]")
	    | otherwise     = empty
994
995
    ppr_package HomePackage = empty
    ppr_package (ExtPackage id) = doubleQuotes (ppr id)
996

997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
    exp_vers  = mi_exp_vers iface
    rule_vers = mi_rule_vers iface

    pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty
		| otherwise = brackets (ppr exp_vers <+> ppr rule_vers)
\end{code}

When printing export lists, we print like this:
	Avail   f		f
	AvailTC C [C, x, y]	C(x,y)
	AvailTC C [x, y]	C!(x,y)		-- Exporting x, y but not C

\begin{code}
pprExport :: IfaceExport -> SDoc
pprExport (mod, items)
 = hsep [ ptext SLIT("export"), ppr mod, hsep (map pp_avail items) ]
  where
    pp_avail :: GenAvailInfo OccName -> SDoc
    pp_avail (Avail occ)    = ppr occ
    pp_avail (AvailTC _ []) = empty
    pp_avail (AvailTC n (n':ns)) 
	| n==n'     = ppr n <> pp_export ns
 	| otherwise = ppr n <> char '|' <> pp_export (n':ns)
    
    pp_export []    = empty
    pp_export names = braces (hsep (map ppr names))

pprUsage :: Usage -> SDoc
pprUsage usage
  = hsep [ptext SLIT("import"), ppr (usg_name usage), 
	  int (usg_mod usage), 
	  pp_export_version (usg_exports usage),
	  int (usg_rules usage),
	  pp_versions (usg_entities usage) ]
  where
    pp_versions nvs = hsep [ ppr n <+> int v | (n,v) <- nvs ]
    pp_export_version Nothing  = empty
    pp_export_version (Just v) = int v

pprDeps :: Dependencies -> SDoc
pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs})
  = vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods),
	  ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs), 
	  ptext SLIT("orphans:") <+> fsep (map ppr orphs)
	]
  where
    ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
    ppr_boot True  = text "[boot]"
    ppr_boot False = empty

pprIfaceDecl :: (Version, IfaceDecl) -> SDoc
pprIfaceDecl (ver, decl)
  = ppr_vers ver <+> ppr decl
  where
	-- Print the version for the decl
    ppr_vers v | v == initialVersion = empty
	       | otherwise	     = int v

pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities []    = empty
pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes
		  where
		    pprFix (occ,fix) = ppr fix <+> ppr occ 

pprDeprecs NoDeprecs	    = empty
pprDeprecs (DeprecAll txt)  = ptext SLIT("Deprecate all") <+> doubleQuotes (ftext txt)
pprDeprecs (DeprecSome prs) = ptext SLIT("Deprecate") <+> vcat (map pprDeprec prs)
			    where
			      pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt)
\end{code}