LoadIface.lhs 23.8 KB
Newer Older
Simon Marlow's avatar
Simon Marlow committed
1 2
%
% (c) The University of Glasgow 2006
3 4
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
Simon Marlow's avatar
Simon Marlow committed
5 6

Loading interface files
7 8 9

\begin{code}
module LoadIface (
Simon Marlow's avatar
Simon Marlow committed
10
	loadInterface, loadInterfaceForName, loadWiredInHomeIface, 
11
	loadSrcInterface, loadSysInterface, loadOrphanModules, 
12
	findAndReadIface, readIface,	-- Used when reading the module's old interface
13
	loadDecls,	-- Should move to TcIface and be renamed
14 15
	initExternalPackageState,

16
	ifaceStats, pprModIface, showIface
17 18 19 20
   ) where

#include "HsVersions.h"

21
import {-# SOURCE #-}	TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst, 
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
22
				 tcIfaceFamInst, tcIfaceVectInfo )
23

Simon Marlow's avatar
Simon Marlow committed
24
import DynFlags
25
import IfaceSyn
Simon Marlow's avatar
Simon Marlow committed
26 27 28 29
import IfaceEnv
import HscTypes

import BasicTypes hiding (SuccessFlag(..))
30
import TcRnMonad
Simon Marlow's avatar
Simon Marlow committed
31 32 33 34 35 36 37 38 39
import Type

import PrelNames
import PrelInfo
import PrelRules
import Rules
import InstEnv
import FamInstEnv
import Name
40
import NameEnv
Simon Marlow's avatar
Simon Marlow committed
41
import MkId
Simon Marlow's avatar
Simon Marlow committed
42
import Module
Simon Marlow's avatar
Simon Marlow committed
43 44 45 46 47
import OccName
import SrcLoc
import Maybes
import ErrUtils
import Finder
Simon Marlow's avatar
Simon Marlow committed
48
import UniqFM
Simon Marlow's avatar
Simon Marlow committed
49
import StaticFlags
50
import Outputable
Simon Marlow's avatar
Simon Marlow committed
51 52 53 54 55 56
import BinIface
import Panic

import Data.List
import Data.Maybe
import Data.IORef
57 58 59 60 61
\end{code}


%************************************************************************
%*									*
62
	loadSrcInterface, loadOrphanModules, loadHomeInterface
63

64
		These three are called from TcM-land	
65 66 67 68
%*									*
%************************************************************************

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
-- | Load the interface corresponding to an @import@ directive in 
-- source code.  On a failure, fail in the monad with an error message.
loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -> RnM ModIface
loadSrcInterface doc mod want_boot  = do 	
  -- We must first find which Module this import refers to.  This involves
  -- calling the Finder, which as a side effect will search the filesystem
  -- and create a ModLocation.  If successful, loadIface will read the
  -- interface; it will call the Finder again, but the ModLocation will be
  -- cached from the first search.
  hsc_env <- getTopEnv
  res <- ioToIOEnv $ findImportedModule hsc_env mod Nothing
  case res of
    Found _ mod -> do
      mb_iface <- initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
      case mb_iface of
84
	Failed err      -> failWithTc err
Simon Marlow's avatar
Simon Marlow committed
85 86 87
	Succeeded iface -> return iface
    err ->
        let dflags = hsc_dflags hsc_env in
88
	failWithTc (cannotFindInterface dflags mod err)
89

Simon Marlow's avatar
Simon Marlow committed
90
-- | Load interfaces for a collection of orphan modules.
91 92 93 94
loadOrphanModules :: [Module]	      -- the modules
		  -> Bool	      -- these are family instance-modules
		  -> TcM ()
loadOrphanModules mods isFamInstMod
95 96 97 98 99 100 101 102
  | null mods = returnM ()
  | otherwise = initIfaceTcRn $
		do { traceIf (text "Loading orphan modules:" <+> 
		     		 fsep (map ppr mods))
		   ; mappM_ load mods
		   ; returnM () }
  where
    load mod   = loadSysInterface (mk_doc mod) mod
103 104 105
    mk_doc mod 
      | isFamInstMod = ppr mod <+> ptext SLIT("is a family-instance module")
      | otherwise    = ppr mod <+> ptext SLIT("is a orphan-instance module")
106

Simon Marlow's avatar
Simon Marlow committed
107 108 109
-- | Loads the interface for a given Name.
loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
loadInterfaceForName doc name
110 111 112 113 114 115 116 117
  = do	{ 
#ifdef DEBUG
		-- Should not be called with a name from the module being compiled
	  this_mod <- getModule
	; ASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc )
#endif
	  initIfaceTcRn $ loadSysInterface doc (nameModule name)
    }
118

Simon Marlow's avatar
Simon Marlow committed
119
-- | An 'IfM' function to load the home interface for a wired-in thing,
120
-- so that we're sure that we see its instance declarations and rules
Simon Marlow's avatar
Simon Marlow committed
121
loadWiredInHomeIface :: Name -> IfM lcl ()
122 123
loadWiredInHomeIface name
  = ASSERT( isWiredInName name )
Simon Marlow's avatar
Simon Marlow committed
124
    do loadSysInterface doc (nameModule name); return ()
125 126 127
  where
    doc = ptext SLIT("Need home interface for wired-in thing") <+> ppr name

Simon Marlow's avatar
Simon Marlow committed
128
-- | A wrapper for 'loadInterface' that throws an exception if it fails
129
loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
130 131 132
loadSysInterface doc mod_name
  = do	{ mb_iface <- loadInterface doc mod_name ImportBySystem
	; case mb_iface of 
133 134
	    Failed err      -> ghcError (ProgramError (showSDoc err))
	    Succeeded iface -> return iface }
135 136 137 138 139 140 141 142 143 144 145 146 147 148
\end{code}


%*********************************************************
%*							*
		loadInterface

	The main function to load an interface
	for an imported module, and put it in
	the External Package State
%*							*
%*********************************************************

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
149
loadInterface :: SDoc -> Module -> WhereFrom
150
	      -> IfM lcl (MaybeErr Message ModIface)
151

152 153 154
-- loadInterface looks in both the HPT and PIT for the required interface
-- If not found, it loads it, and puts it in the PIT (always). 

155 156 157 158 159 160 161
-- If it can't find a suitable interface file, we
--	a) modify the PackageIfaceTable to have an empty entry
--		(to avoid repeated complaints)
--	b) return (Left message)
--
-- It's not necessarily an error for there not to be an interface
-- file -- perhaps the module has changed, and that interface 
162
-- is no longer used
163

164
loadInterface doc_str mod from
165
  = do	{ 	-- Read the state
166
	  (eps,hpt) <- getEpsAndHpt
167

168
	; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
169

170
		-- Check whether we have the interface already
Simon Marlow's avatar
Simon Marlow committed
171 172
 	; dflags <- getDOpts
	; case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of {
173
	    Just iface 
174
		-> returnM (Succeeded iface) ;	-- Already loaded
175 176
			-- The (src_imp == mi_boot iface) test checks that the already-loaded
			-- interface isn't a boot iface.  This can conceivably happen,
177
			-- if an earlier import had a before we got to real imports.   I think.
Simon Marlow's avatar
Simon Marlow committed
178
	    other -> do {
179

Simon Marlow's avatar
Simon Marlow committed
180
          let { hi_boot_file = case from of
181
				ImportByUser usr_boot -> usr_boot
182
				ImportBySystem        -> sys_boot
183

Simon Marlow's avatar
Simon Marlow committed
184
	      ; mb_dep   = lookupUFM (eps_is_boot eps) (moduleName mod)
185 186 187 188 189 190 191
	      ; sys_boot = case mb_dep of
				Just (_, is_boot) -> is_boot
				Nothing		  -> False
			-- The boot-ness of the requested interface, 
	      }		-- based on the dependencies in directly-imported modules

	-- READ THE MODULE IN
Simon Marlow's avatar
Simon Marlow committed
192
	; read_result <- findAndReadIface doc_str mod hi_boot_file
193
	; case read_result of {
194
	    Failed err -> do
Simon Marlow's avatar
Simon Marlow committed
195
	  	{ let fake_iface = emptyModIface mod
196 197 198 199

		; updateEps_ $ \eps ->
			eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
			-- Not found, so add an empty iface to 
200
			-- the EPS map so that we don't look again
201
				
202
		; returnM (Failed err) } ;
203 204

	-- Found and parsed!
205
	    Succeeded (iface, file_path) 	-- Sanity check:
Simon Marlow's avatar
Simon Marlow committed
206 207 208 209
		| ImportBySystem <- from,	--   system-importing...
		  modulePackageId (mi_module iface) == thisPackage dflags,
		  				--   a home-package module...
		  Nothing <- mb_dep		--   that we know nothing about
210
		-> returnM (Failed (badDepMsg mod))
211

212
		| otherwise ->
213

214
	let 
215
	    loc_doc = text file_path
216 217
	in 
	initIfaceLcl mod loc_doc $ do
218 219 220 221 222 223 224 225 226

	-- 	Load the new ModIface into the External Package State
	-- Even home-package interfaces loaded by loadInterface 
	-- 	(which only happens in OneShot mode; in Batch/Interactive 
	--  	mode, home-package modules are loaded one by one into the HPT)
	-- are put in the EPS.
	--
	-- The main thing is to add the ModIface to the PIT, but
	-- we also take the
227
	--	IfaceDecls, IfaceInst, IfaceFamInst, IfaceRules, IfaceVectInfo
228 229 230 231 232 233 234
	-- out of the ModIface and put them into the big EPS pools

	-- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
	---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
	--     If we do loadExport first the wrong info gets into the cache (unless we
	-- 	explicitly tag each export which seems a bit of a bore)

235 236 237 238 239
	; ignore_prags      <- doptM Opt_IgnoreInterfacePragmas
	; new_eps_decls     <- loadDecls ignore_prags (mi_decls iface)
	; new_eps_insts     <- mapM tcIfaceInst (mi_insts iface)
	; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
	; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
240 241
        ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls) 
                                               (mi_vect_info iface)
242

243 244 245 246 247
	; let {	final_iface = iface {	
			        mi_decls     = panic "No mi_decls in PIT",
				mi_insts     = panic "No mi_insts in PIT",
				mi_fam_insts = panic "No mi_fam_insts in PIT",
				mi_rules     = panic "No mi_rules in PIT"
248 249
                              }
               }
250 251

	; updateEps_  $ \ eps -> 
252 253 254 255 256 257 258 259 260
	    eps { 
	      eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
	      eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
	      eps_rule_base    = extendRuleBaseList (eps_rule_base eps) 
						    new_eps_rules,
	      eps_inst_env     = extendInstEnvList (eps_inst_env eps)  
						   new_eps_insts,
	      eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
						      new_eps_fam_insts,
261 262
              eps_vect_info    = plusVectInfo (eps_vect_info eps) 
                                              new_eps_vect_info,
263 264 265 266 267 268 269 270 271
              eps_mod_fam_inst_env
			       = let
				   fam_inst_env = 
				     extendFamInstEnvList emptyFamInstEnv
							  new_eps_fam_insts
				 in
				 extendModuleEnv (eps_mod_fam_inst_env eps)
						 mod
						 fam_inst_env,
272 273 274
	      eps_stats        = addEpsInStats (eps_stats eps) 
					       (length new_eps_decls)
	      (length new_eps_insts) (length new_eps_rules) }
275

276 277 278 279 280
	; return (Succeeded final_iface)
    }}}}

badDepMsg mod 
  = hang (ptext SLIT("Interface file inconsistency:"))
281 282
       2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is mentioned is needed,"), 
	       ptext SLIT("but is not among the dependencies of interfaces directly imported by the module being compiled")])
283 284 285 286 287 288 289 290

-----------------------------------------------------
--	Loading type/class/value decls
-- We pass the full Module name here, replete with
-- its package info, so that we can build a Name for
-- each binder with the right package info in it
-- All subsequent lookups, including crucially lookups during typechecking
-- the declaration itself, will find the fully-glorious Name
291 292 293 294
--
-- We handle ATs specially.  They are not main declarations, but also not
-- implict things (in particular, adding them to `implicitTyThings' would mess
-- things up in the renaming/type checking of source programs).
295 296
-----------------------------------------------------

297 298 299 300 301 302 303 304 305 306 307
addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
addDeclsToPTE pte things = extendNameEnvList pte things

loadDecls :: Bool
	  -> [(Version, IfaceDecl)]
	  -> IfL [(Name,TyThing)]
loadDecls ignore_prags ver_decls
   = do { mod <- getIfModule
 	; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
	; return (concat thingss)
	}
308

309
loadDecl :: Bool		    -- Don't load pragmas into the decl pool
310
	 -> Module
311
	  -> (Version, IfaceDecl)
312 313
	  -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
				    -- TyThings are forkM'd thunks
314
loadDecl ignore_prags mod (_version, decl)
315 316
  = do 	{ 	-- Populate the name cache with final versions of all 
		-- the names associated with the decl
317
	  main_name      <- mk_new_bndr mod (ifName decl)
318
--        ; traceIf (text "Loading decl for " <> ppr main_name)
319
	; implicit_names <- mapM (mk_new_bndr mod) (ifaceDeclSubBndrs decl)
320 321

	-- Typecheck the thing, lazily
322
	-- NB. Firstly, the laziness is there in case we never need the
323 324 325 326
	-- declaration (in one-shot mode), and secondly it is there so that 
	-- we don't look up the occurrence of a name before calling mk_new_bndr
	-- on the binder.  This is important because we must get the right name
	-- which includes its nameParent.
327 328 329 330

	; thing <- forkM doc $ do { bumpDeclStats main_name
				  ; tcIfaceDecl ignore_prags decl }

331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351
	-- Populate the type environment with the implicitTyThings too.
	-- 
	-- Note [Tricky iface loop]
	-- ~~~~~~~~~~~~~~~~~~~~~~~~
	-- The delicate point here is that 'mini-env' should be
	-- buildable from 'thing' without demanding any of the things 'forkM'd 
	-- by tcIfaceDecl.  For example
	--	class C a where { data T a; op :: T a -> Int }
	-- We return the bindings
	--	[("C", <cls>), ("T", lookup env "T"), ("op", lookup env "op")]
	-- The call (lookup env "T") must return the tycon T without first demanding
	-- op; because getting the latter will look up T, hence loop.
	--
	-- Of course, there is no reason in principle why (lookup env "T") should demand
	-- anything do to with op, but take care: 
	--	(a) implicitTyThings, and 
	--	(b) getOccName of all the things returned by implicitThings, 
	-- must not depend on any of the nested type-checks
	-- 
	-- All a bit too finely-balanced for my liking.

352 353 354
	; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
	      lookup n = case lookupOccEnv mini_env (getOccName n) of
			   Just thing -> thing
355
			   Nothing    -> 
356
			     pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
357

358 359
	; returnM $ (main_name, thing) :  [(n, lookup n) | n <- implicit_names]
	}
360 361 362
		-- We build a list from the *known* names, with (lookup n) thunks
		-- as the TyThings.  That way we can extend the PTE without poking the
		-- thunks
363 364 365 366 367 368
  where
	-- mk_new_bndr allocates in the name cache the final canonical
	-- name for the thing, with the correct 
	--	* parent
	--	* location
	-- imported name, to fix the module correctly in the cache
369
    mk_new_bndr mod occ 
370
	= newGlobalBinder mod occ (importedSrcSpan (moduleNameFS (moduleName mod)))
371
			-- ToDo: qualify with the package name if necessary
372

373
    doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
374

375 376 377 378 379 380
bumpDeclStats :: Name -> IfL ()		-- Record that one more declaration has actually been used
bumpDeclStats name
  = do	{ traceIf (text "Loading decl for" <+> ppr name)
	; updateEps_ (\eps -> let stats = eps_stats eps
			      in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
	}
381 382 383 384 385 386 387 388 389 390
\end{code}


%*********************************************************
%*							*
\subsection{Reading an interface file}
%*							*
%*********************************************************

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
391
findAndReadIface :: SDoc -> Module
392 393
		 -> IsBootInterface	-- True  <=> Look for a .hi-boot file
					-- False <=> Look for .hi file
394
		 -> TcRnIf gbl lcl (MaybeErr Message (ModIface, FilePath))
395 396 397 398 399 400
	-- Nothing <=> file not found, or unreadable, or illegible
	-- Just x  <=> successfully found and parsed 

	-- It *doesn't* add an error to the monad, because 
	-- sometimes it's ok to fail... see notes with loadInterface

Simon Marlow's avatar
Simon Marlow committed
401
findAndReadIface doc_str mod hi_boot_file
402 403 404 405 406
  = do	{ traceIf (sep [hsep [ptext SLIT("Reading"), 
			      if hi_boot_file 
				then ptext SLIT("[boot]") 
				else empty,
			      ptext SLIT("interface for"), 
Simon Marlow's avatar
Simon Marlow committed
407
			      ppr mod <> semi],
408 409 410
		        nest 4 (ptext SLIT("reason:") <+> doc_str)])

	-- Check for GHC.Prim, and return its static interface
411
	; dflags <- getDOpts
Simon Marlow's avatar
Simon Marlow committed
412 413 414
	; if mod == gHC_PRIM
	  then returnM (Succeeded (ghcPrimIface, 
				   "<built in interface for GHC.Prim>"))
415 416 417
	  else do

	-- Look for the file
418
	; hsc_env <- getTopEnv
Simon Marlow's avatar
Simon Marlow committed
419
	; mb_found <- ioToIOEnv (findExactModule hsc_env mod)
420
	; case mb_found of {
Simon Marlow's avatar
Simon Marlow committed
421 422
              
	      err | notFound err -> do
423 424
		{ traceIf (ptext SLIT("...not found"))
		; dflags <- getDOpts
425 426
		; returnM (Failed (cannotFindInterface dflags 
					(moduleName mod) err)) } ;
Simon Marlow's avatar
Simon Marlow committed
427
	      Found loc mod -> do 
428 429

	-- Found file, so read it
Simon Marlow's avatar
Simon Marlow committed
430 431 432 433 434 435 436 437
	{ let { file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) }

        ; if thisPackage dflags == modulePackageId mod
                && not (isOneShot (ghcMode dflags))
            then returnM (Failed (homeModError mod loc))
            else do {

        ; traceIf (ptext SLIT("readIFace") <+> text file_path)
Simon Marlow's avatar
Simon Marlow committed
438
	; read_result <- readIface mod file_path hi_boot_file
439
	; case read_result of
440 441
	    Failed err -> returnM (Failed (badIfaceFile file_path err))
	    Succeeded iface 
Simon Marlow's avatar
Simon Marlow committed
442 443
		| mi_module iface /= mod ->
		  return (Failed (wrongIfaceModErr iface mod file_path))
444
		| otherwise ->
Simon Marlow's avatar
Simon Marlow committed
445
		  returnM (Succeeded (iface, file_path))
446
			-- Don't forget to fill in the package name...
Simon Marlow's avatar
Simon Marlow committed
447 448 449 450
	}}}}

notFound (Found _ _) = False
notFound _ = True
451 452 453 454 455
\end{code}

@readIface@ tries just the one file.

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
456
readIface :: Module -> FilePath -> IsBootInterface 
457
	  -> TcRnIf gbl lcl (MaybeErr Message ModIface)
458 459
	-- Failed err    <=> file not found, or unreadable, or illegible
	-- Succeeded iface <=> successfully found and parsed 
460

461
readIface wanted_mod file_path is_hi_boot_file
462
  = do	{ dflags <- getDOpts
463
        ; res <- tryMostM $ readBinIface file_path
464
	; case res of
465 466 467 468 469 470 471 472
	    Right iface 
		| wanted_mod == actual_mod -> return (Succeeded iface)
		| otherwise	  	   -> return (Failed err)
		where
		  actual_mod = mi_module iface
		  err = hiModuleNameMismatchWarn wanted_mod actual_mod

	    Left exn    -> return (Failed (text (showException exn)))
473
    }
474 475 476 477 478 479 480 481 482 483 484 485 486
\end{code}


%*********************************************************
%*						 	 *
	Wired-in interface for GHC.Prim
%*							 *
%*********************************************************

\begin{code}
initExternalPackageState :: ExternalPackageState
initExternalPackageState
  = EPS { 
487 488 489 490 491 492
      eps_is_boot      = emptyUFM,
      eps_PIT          = emptyPackageIfaceTable,
      eps_PTE          = emptyTypeEnv,
      eps_inst_env     = emptyInstEnv,
      eps_fam_inst_env = emptyFamInstEnv,
      eps_rule_base    = mkRuleBase builtinRules,
493
	-- Initialise the EPS rule pool with the built-in rules
494 495
      eps_mod_fam_inst_env
                       = emptyModuleEnv,
496
      eps_vect_info    = noVectInfo,
497 498 499
      eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
			   , n_insts_in = 0, n_insts_out = 0
			   , n_rules_in = length builtinRules, n_rules_out = 0 }
500 501 502 503 504 505 506 507 508 509 510 511 512
    }
\end{code}


%*********************************************************
%*						 	 *
	Wired-in interface for GHC.Prim
%*							 *
%*********************************************************

\begin{code}
ghcPrimIface :: ModIface
ghcPrimIface
Simon Marlow's avatar
Simon Marlow committed
513
  = (emptyModIface gHC_PRIM) {
514
	mi_exports  = [(gHC_PRIM, ghcPrimExports)],
515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532
	mi_decls    = [],
	mi_fixities = fixities,
	mi_fix_fn  = mkIfaceFixCache fixities
    }		
  where
    fixities = [(getOccName seqId, Fixity 0 InfixR)]
			-- seq is infixr 0
\end{code}

%*********************************************************
%*							*
\subsection{Statistics}
%*							*
%*********************************************************

\begin{code}
ifaceStats :: ExternalPackageState -> SDoc
ifaceStats eps 
533
  = hcat [text "Renamer stats: ", msg]
534
  where
535 536 537 538 539 540 541 542 543
    stats = eps_stats eps
    msg = vcat 
    	[int (n_ifaces_in stats) <+> text "interfaces read",
    	 hsep [ int (n_decls_out stats), text "type/class/variable imported, out of", 
    	        int (n_decls_in stats), text "read"],
    	 hsep [ int (n_insts_out stats), text "instance decls imported, out of",  
    	        int (n_insts_in stats), text "read"],
    	 hsep [ int (n_rules_out stats), text "rule decls imported, out of",  
    	        int (n_rules_in stats), text "read"]
544
	]
SamB's avatar
SamB committed
545
\end{code}
546 547


548 549 550 551 552 553 554
%************************************************************************
%*				 					*
		Printing interfaces
%*				 					*
%************************************************************************

\begin{code}
555 556 557
-- | Read binary interface, and print it out
showIface :: HscEnv -> FilePath -> IO ()
showIface hsc_env filename = do
558 559 560
   -- skip the version check; we don't want to worry about profiled vs.
   -- non-profiled interfaces, for example.
   writeIORef v_IgnoreHiWay True
561
   iface <- initTcRnIf 's' hsc_env () () $ readBinIface  filename
562 563 564 565 566 567 568 569 570 571 572
   printDump (pprModIface iface)
\end{code}

\begin{code}
pprModIface :: ModIface -> SDoc
-- Show a ModIface
pprModIface iface
 = vcat [ ptext SLIT("interface")
		<+> ppr (mi_module iface) <+> pp_boot 
		<+> ppr (mi_mod_vers iface) <+> pp_sub_vers
		<+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
573
		<+> (if mi_finsts iface then ptext SLIT("[family instance module]") else empty)
574
		<+> integer opt_HiVersion
575 576 577 578 579 580 581
		<+> 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))
582
	, vcat (map ppr (mi_fam_insts iface))
583
	, vcat (map ppr (mi_rules iface))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
584
        , pprVectInfo (mi_vect_info iface)
585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630
	, pprDeprecs (mi_deprecs iface)
	]
  where
    pp_boot | mi_boot iface = ptext SLIT("[boot]")
	    | otherwise     = empty

    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
631 632
pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
		dep_finsts = finsts })
633 634
  = vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods),
	  ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs), 
635 636
	  ptext SLIT("orphans:") <+> fsep (map ppr orphs),
	  ptext SLIT("family instance modules:") <+> fsep (map ppr finsts)
637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656
	]
  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 

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
657 658 659 660
pprVectInfo :: IfaceVectInfo -> SDoc
pprVectInfo (IfaceVectInfo names) = 
  ptext SLIT("Closured converted:") <+> hsep (map ppr names)

661 662 663 664 665 666 667 668
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}


669 670 671 672 673 674 675 676 677 678 679
%*********************************************************
%*						 	 *
\subsection{Errors}
%*							 *
%*********************************************************

\begin{code}
badIfaceFile file err
  = vcat [ptext SLIT("Bad interface file:") <+> text file, 
	  nest 4 err]

680
hiModuleNameMismatchWarn :: Module -> Module -> Message
681
hiModuleNameMismatchWarn requested_mod read_mod = 
Simon Marlow's avatar
Simon Marlow committed
682 683 684 685
  withPprStyle defaultUserStyle $
    -- we want the Modules below to be qualified with package names,
    -- so reset the PrintUnqualified setting.
    hsep [ ptext SLIT("Something is amiss; requested module ")
686 687 688 689 690
	 , ppr requested_mod
	 , ptext SLIT("differs from name found in the interface file")
   	 , ppr read_mod
  	 ]

691 692 693 694 695 696 697 698 699 700
wrongIfaceModErr iface mod_name file_path 
  = sep [ptext SLIT("Interface file") <+> iface_file,
         ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
         ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
	 sep [ptext SLIT("Probable cause: the source code which generated"),
	     nest 2 iface_file,
	     ptext SLIT("has an incompatible module name")
	    ]
	]
  where iface_file = doubleQuotes (text file_path)
Simon Marlow's avatar
Simon Marlow committed
701 702 703 704 705 706 707

homeModError mod location
  = ptext SLIT("attempting to use module ") <> quotes (ppr mod)
    <> (case ml_hs_file location of
           Just file -> space <> parens (text file)
           Nothing   -> empty)
    <+> ptext SLIT("which is not loaded")
708
\end{code}
709