[project @ 2000-05-25 12:41:14 by simonpj]

~~~~~~~~~~~~
		Apr/May 2000
		~~~~~~~~~~~~

This is a pretty big commit!  It adds stuff I've been working on
over the last month or so.  DO NOT MERGE IT WITH 4.07!

Interface file formats have changed a little; you'll need
to make clean before remaking.

						Simon PJ

Recompilation checking
~~~~~~~~~~~~~~~~~~~~~~
Substantial improvement in recompilation checking.  The version management
is now entirely internal to GHC.  ghc-iface.lprl is dead!

The trick is to generate the new interface file in two steps:
  - first convert Types etc to HsTypes etc, and thereby
	build a new ParsedIface
  - then compare against the parsed (but not renamed) version of the old
	interface file
Doing this meant adding code to convert *to* HsSyn things, and to
compare HsSyn things for equality.  That is the main tedious bit.

Another improvement is that we now track version info for
fixities and rules, which was missing before.


Interface file reading
~~~~~~~~~~~~~~~~~~~~~~
Make interface files reading more robust.
  * If the old interface file is unreadable, don't fail. [bug fix]

  * If the old interface file mentions interfaces
    that are unreadable, don't fail. [bug fix]

  * When we can't find the interface file,
    print the directories we are looking in.  [feature]


Type signatures
~~~~~~~~~~~~~~~
  * New flag -ddump-types to print type signatures


Type pruning
~~~~~~~~~~~~
When importing
	data T = T1 A | T2 B | T3 C
it seems excessive to import the types A, B, C as well, unless
the constructors T1, T2 etc are used.  A,B,C might be more types,
and importing them may mean reading more interfaces, and so on.
 So the idea is that the renamer will just import the decl
	data T
unless one of the constructors is used.  This turns out to be quite
easy to implement.  The downside is that we must make sure the
constructors are always available if they are really needed, so
I regard this as an experimental feature.


Elimininate ThinAir names
~~~~~~~~~~~~~~~~~~~~~~~~~
Eliminate ThinAir.lhs and all its works.  It was always a hack, and now
the desugarer carries around an environment I think we can nuke ThinAir
altogether.

As part of this, I had to move all the Prelude RdrName defns from PrelInfo
to PrelMods --- so I renamed PrelMods as PrelNames.

I also had to move the builtinRules so that they are injected by the renamer
(rather than appearing out of the blue in SimplCore).  This is if anything simpler.

Miscellaneous
~~~~~~~~~~~~~
* Tidy up the data types involved in Rules

* Eliminate RnEnv.better_provenance; use Name.hasBetterProv instead

* Add Unique.hasKey :: Uniquable a => a -> Unique -> Bool
  It's useful in a lot of places

* Fix a bug in interface file parsing for __U[!]

5 files changed, 487 insertions, 545 deletions

diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index ca1b58d012..25d080ea68 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -137,6 +137,7 @@ module CmdLineOpts (
 	opt_ProduceExportCStubs,
 	opt_ProduceExportHStubs,
 	opt_ProduceHi,
+	opt_NoPruneTyDecls,
 	opt_NoPruneDecls,
 	opt_ReportCompile,
 	opt_SourceUnchanged,
@@ -453,6 +454,7 @@ opt_UF_DearOp   = ( 4 :: Int)
 			
 opt_ReportCompile               = lookUp SLIT("-freport-compile")
 opt_NoPruneDecls		= lookUp SLIT("-fno-prune-decls")
+opt_NoPruneTyDecls		= lookUp SLIT("-fno-prune-tydecls")
 opt_SourceUnchanged		= lookUp SLIT("-fsource-unchanged")
 opt_Static			= lookUp SLIT("-static")
 opt_Unregisterised		= lookUp SLIT("-funregisterised")
diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs
index 18b538b168..6c64a5c41e 100644
--- a/ghc/compiler/main/CodeOutput.lhs
+++ b/ghc/compiler/main/CodeOutput.lhs
@@ -32,7 +32,7 @@ import CmdLineOpts
 import Maybes		( maybeToBool )
 import ErrUtils		( doIfSet, dumpIfSet )
 import Outputable
-import IO
+import IO		( IOMode(..), hClose, openFile )
 \end{code}
 
 
@@ -109,8 +109,8 @@ outputAsm flat_absC ncg_uniqs
 
 #else /* OMIT_NATIVE_CODEGEN */
 
-  = do 	hPutStrLn stderr "This compiler was built without a native code generator"
-	hPutStrLn stderr "Use -fvia-C instead"
+  = pprPanic "This compiler was built without a native code generator"
+	     (text "Use -fvia-C instead")
 
 #endif
 \end{code}
diff --git a/ghc/compiler/main/Constants.lhs b/ghc/compiler/main/Constants.lhs
index 641b9f769b..771b5132c8 100644
--- a/ghc/compiler/main/Constants.lhs
+++ b/ghc/compiler/main/Constants.lhs
@@ -207,8 +207,9 @@ wORD64_SIZE    = (WORD64_SIZE   :: Int)
 iNT64_SIZE     = (INT64_SIZE   :: Int)
 \end{code}
 
-The version of the interface file format we're
-using:
+The version of the interface file format we're using.  It's propagated
+here by a devious route from ghc/mk/version.mk.  See comments
+there for what it means.
 
 \begin{code}
 interfaceFileFormatVersion :: Int
diff --git a/ghc/compiler/main/Main.lhs b/ghc/compiler/main/Main.lhs
index 4ffef76d06..beb70cba7d 100644
--- a/ghc/compiler/main/Main.lhs
+++ b/ghc/compiler/main/Main.lhs
@@ -20,9 +20,8 @@ import Lex		( PState(..), P, ParseResult(..) )
 import SrcLoc		( mkSrcLoc )
 
 import Rename		( renameModule )
-import RnMonad		( InterfaceDetails(..) )
 
-import MkIface		( startIface, ifaceDecls, endIface )
+import MkIface		( writeIface )
 import TcModule		( TcResults(..), typecheckModule )
 import Desugar		( deSugar )
 import SimplCore	( core2core )
@@ -124,24 +123,18 @@ doIt (core_cmds, stg_cmds)
 			reportCompile mod_name "Compilation NOT required!" >>
 			return ();
 	
-	Just (this_mod, rn_mod, iface_file_stuff@(InterfaceDetails _ _ _ deprecations),
-	      rn_name_supply, imported_modules) ->
+	Just (this_mod, rn_mod, 
+	      old_iface, new_iface,
+	      rn_name_supply, fixity_env,
+	      imported_modules) ->
 			-- Oh well, we've got to recompile for real
 
 
-	--------------------------  Start interface file  ----------------
-    -- Safely past renaming: we can start the interface file:
-    -- (the iface file is produced incrementally, as we have
-    -- the information that we need...; we use "iface<blah>")
-    -- "endIface" finishes the job.
-    startIface this_mod iface_file_stuff	>>= \ if_handle ->
-
-
 	--------------------------  Typechecking ----------------
     show_pass "TypeCheck" 				>>
     _scc_     "TypeCheck"
     typecheckModule tc_uniqs rn_name_supply
-		    iface_file_stuff rn_mod	        >>= \ maybe_tc_stuff ->
+		    fixity_env rn_mod	        >>= \ maybe_tc_stuff ->
     case maybe_tc_stuff of {
 	Nothing -> ghcExit 1;	-- Type checker failed
 
@@ -163,6 +156,12 @@ doIt (core_cmds, stg_cmds)
     tidyCorePgm tidy_uniqs this_mod
 		simplified orphan_rules			>>= \ (tidy_binds, tidy_orphan_rules) -> 
 
+    coreBindsSize tidy_binds `seq`
+--	TEMP: the above call zaps some space usage allocated by the
+--	simplifier, which for reasons I don't understand, persists
+--	thoroughout code generation
+
+
 
 	--------------------------  Convert to STG code -------------------------------
     show_pass "Core2Stg" 			>>
@@ -183,16 +182,9 @@ doIt (core_cmds, stg_cmds)
     let
 	final_ids = collectFinalStgBinders (map fst stg_binds2)
     in
-    coreBindsSize tidy_binds `seq`
---	TEMP: the above call zaps some space usage allocated by the
---	simplifier, which for reasons I don't understand, persists
---	thoroughout code generation
-
-    ifaceDecls if_handle local_tycons local_classes inst_info
-	       final_ids tidy_binds tidy_orphan_rules deprecations	>>
-    endIface if_handle						>>
-	    -- We are definitely done w/ interface-file stuff at this point:
-	    -- (See comments near call to "startIface".)
+    writeIface this_mod old_iface new_iface
+	       local_tycons local_classes inst_info
+	       final_ids tidy_binds tidy_orphan_rules 		>>
 
 
 	--------------------------  Code generation -------------------------------
@@ -331,8 +323,8 @@ ppSourceStats short (HsModule name version exports imports decls _ src_loc)
     spec_info (Just (False, _)) = (0,0,0,0,1,0)
     spec_info (Just (True, _))  = (0,0,0,0,0,1)
 
-    data_info (TyData _ _ _ _ constrs derivs _ _)
-	= (length constrs, case derivs of {Nothing -> 0; Just ds -> length ds})
+    data_info (TyData _ _ _ _ _ nconstrs derivs _ _)
+	= (nconstrs, case derivs of {Nothing -> 0; Just ds -> length ds})
     data_info other = (0,0)
 
     class_info (ClassDecl _ _ _ _ meth_sigs def_meths _ _ _ _ _ _)
diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 50ebde3837..7370529ffa 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -4,9 +4,7 @@
 \section[MkIface]{Print an interface for a module}
 
 \begin{code}
-module MkIface (
-	startIface, endIface, ifaceDecls
-    ) where
+module MkIface ( writeIface  ) where
 
 #include "HsVersions.h"
 
@@ -14,8 +12,12 @@ import IO		( Handle, hPutStr, openFile,
 			  hClose, hPutStrLn, IOMode(..) )
 
 import HsSyn
-import BasicTypes	( Fixity(..), FixityDirection(..), NewOrData(..), 
-			  OccInfo, isLoopBreaker
+import HsCore		( HsIdInfo(..), toUfExpr )
+import RdrHsSyn		( RdrNameRuleDecl )
+import HsPragmas	( DataPragmas(..), ClassPragmas(..) )
+import HsTypes		( toHsTyVars )
+import BasicTypes	( Fixity(..), FixityDirection(..), NewOrData(..),
+			  Version, bumpVersion, initialVersion, isLoopBreaker
 			)
 import RnMonad
 import RnEnv		( availName )
@@ -29,24 +31,25 @@ import Id		( Id, idType, idInfo, omitIfaceSigForId, isUserExportedId,
 import Var		( isId )
 import VarSet
 import DataCon		( StrictnessMark(..), dataConSig, dataConFieldLabels, dataConStrictMarks )
-import IdInfo		( IdInfo, StrictnessInfo(..), ArityInfo, InlinePragInfo(..), inlinePragInfo,
-			  arityInfo, ppArityInfo, arityLowerBound,
-			  strictnessInfo, ppStrictnessInfo, isBottomingStrictness,
-			  cafInfo, ppCafInfo, specInfo,
-			  cprInfo, ppCprInfo, pprInlinePragInfo,
+import IdInfo		( IdInfo, StrictnessInfo(..), ArityInfo(..), InlinePragInfo(..), 
+			  CprInfo(..), CafInfo(..),
+			  inlinePragInfo, arityInfo, arityLowerBound,
+			  strictnessInfo, isBottomingStrictness,
+			  cafInfo, specInfo, cprInfo, 
 			  occInfo, isNeverInlinePrag,
-			  workerExists, workerInfo, ppWorkerInfo, WorkerInfo(..)
+			  workerExists, workerInfo, WorkerInfo(..)
 			)
-import CoreSyn		( CoreExpr, CoreBind, Bind(..), rulesRules, rulesRhsFreeVars )
+import CoreSyn		( CoreExpr, CoreBind, Bind(..), isBuiltinRule, rulesRules, rulesRhsFreeVars )
 import CoreFVs		( exprSomeFreeVars, ruleSomeLhsFreeVars, ruleSomeFreeVars )
 import CoreUnfold	( okToUnfoldInHiFile, couldBeSmallEnoughToInline )
 import Module		( moduleString, pprModule, pprModuleName )
-import Name		( isLocallyDefined, isWiredInName, nameRdrName, nameModule,
+import RdrName		( RdrName )
+import Name		( isLocallyDefined, isWiredInName, toRdrName, nameModule,
 			  Name, NamedThing(..)
 			)
 import OccName		( OccName, pprOccName )
 import TyCon		( TyCon, getSynTyConDefn, isSynTyCon, isNewTyCon, isAlgTyCon,
-			  tyConTheta, tyConTyVars, tyConDataCons
+			  tyConTheta, tyConTyVars, tyConDataCons, tyConFamilySize
 			)
 import Class		( Class, classExtraBigSig )
 import FieldLabel	( fieldLabelName, fieldLabelType )
@@ -56,7 +59,6 @@ import Type		( mkSigmaTy, splitSigmaTy, mkDictTy, tidyTopType,
 		        )
 
 import PprType
-import PprCore		( pprIfaceUnfolding, pprCoreRule )
 import FunDeps		( pprFundeps )
 import Rules		( pprProtoCoreRule, ProtoCoreRule(..) )
 
@@ -66,222 +68,311 @@ import FiniteMap	( emptyFM, addToFM, addToFM_C, fmToList, FiniteMap )
 import UniqFM		( lookupUFM, listToUFM )
 import UniqSet		( uniqSetToList )
 import Util		( sortLt, mapAccumL )
+import SrcLoc		( noSrcLoc )
 import Bag
 import Outputable
 \end{code}
 
-We have a function @startIface@ to open the output file and put
-(something like) ``interface Foo'' in it.  It gives back a handle
-for subsequent additions to the interface file.
 
-We then have one-function-per-block-of-interface-stuff, e.g.,
-@ifaceExportList@ produces the @__exports__@ section; it appends
-to the handle provided by @startIface@.
-
-NOTE: ALWAYS remember that ghc-iface.lprl rewrites the interface file,
-so you have to keep it in synch with the code below. Otherwise you'll
-lose the happiest years of your life, believe me...  -- SUP
+%************************************************************************
+%*				 					*
+\subsection{Write a new interface file}
+%*				 					*
+%************************************************************************
 
 \begin{code}
-startIface  :: Module -> InterfaceDetails
-	    -> IO (Maybe Handle) -- Nothing <=> don't do an interface
+writeIface this_mod old_iface new_iface
+	   local_tycons local_classes inst_info
+	   final_ids tidy_binds tidy_orphan_rules
+  = case opt_ProduceHi of {
+      Nothing -> return () ; -- not producing any .hi file
+
+      Just filename ->
+
+    case checkIface old_iface full_new_iface of {
+	Nothing -> do { putStrLn "Interface file unchanged" ;
+		        return () } ;	-- No need to update .hi file
+
+	Just final_iface ->
+
+    do  let mod_vers_unchanged = case old_iface of
+				   Just iface -> pi_vers iface == pi_vers final_iface
+				   Nothing -> False
+     	if mod_vers_unchanged 
+	   then putStrLn "Module version unchanged, but usages differ; hence need new hi file"
+	   else return ()
+
+	if_hdl <- openFile filename WriteMode
+	printForIface if_hdl (pprIface final_iface)
+	hClose if_hdl
+    }}    
+  where
+    full_new_iface = completeIface new_iface local_tycons local_classes
+				   	     inst_info final_ids tidy_binds
+					     tidy_orphan_rules
+\end{code}
 
-ifaceDecls :: Maybe Handle
-	   -> [TyCon] -> [Class]
-	   -> Bag InstInfo 
-	   -> [Id]		-- Ids used at code-gen time; they have better pragma info!
-	   -> [CoreBind]	-- In dependency order, later depend on earlier
-	   -> [ProtoCoreRule]	-- Rules
-	   -> [Deprecation Name]
-	   -> IO ()
 
-endIface    :: Maybe Handle -> IO ()
-\end{code}
+%************************************************************************
+%*				 					*
+\subsection{Checking if the new interface is up to date
+%*				 					*
+%************************************************************************
 
 \begin{code}
-startIface mod (InterfaceDetails has_orphans import_usages (ExportEnv avails fixities _) _)
-  = case opt_ProduceHi of
-      Nothing -> return Nothing ; -- not producing any .hi file
-
-      Just fn -> do 
-	if_hdl <- openFile fn WriteMode
-	hPutStr		if_hdl ("__interface \"" ++ show opt_InPackage ++ "\" " ++ moduleString mod)
-	hPutStr		if_hdl (' ' : orphan_indicator)
-	hPutStrLn	if_hdl " where"
-	ifaceExports	if_hdl avails
-	ifaceImports	if_hdl import_usages
-	ifaceFixities	if_hdl fixities
-	return (Just if_hdl)
+checkIface :: Maybe ParsedIface		-- The old interface, read from M.hi
+	   -> ParsedIface		-- The new interface; but with all version numbers = 1
+	   -> Maybe ParsedIface		-- Nothing => no change; no need to write new Iface
+					-- Just pi => Here is the new interface to write
+					-- 	      with correct version numbers
+
+-- NB: the fixities, declarations, rules are all assumed
+-- to be sorted by increasing order of hsDeclName, so that 
+-- we can compare for equality
+
+checkIface Nothing new_iface
+-- No old interface, so definitely write a new one!
+  = Just new_iface
+
+checkIface (Just iface) new_iface
+  | no_output_change && no_usage_change
+  = Nothing
+
+  | otherwise		-- Add updated version numbers
+  = 
+{-  pprTrace "checkIface" (
+	vcat [ppr no_decl_changed <+> ppr no_export_change <+> ppr no_usage_change,
+	      text "--------",
+	      vcat (map ppr (pi_decls iface)),
+	      text "--------",
+	      vcat (map ppr (pi_decls new_iface))
+	]) $
+-}
+    Just (new_iface { pi_vers = new_mod_vers,
+		      pi_fixity = (new_fixity_vers, new_fixities),
+		      pi_rules  = (new_rules_vers,  new_rules),
+		      pi_decls  = final_decls
+    })
+	
   where
-    orphan_indicator | has_orphans = " !"
-		     | otherwise   = ""
+    no_usage_change = pi_usages iface == pi_usages new_iface
+
+    no_output_change = no_decl_changed && 
+	               new_fixity_vers == fixity_vers && 
+	               new_rules_vers == rules_vers &&
+	               no_export_change
+
+    no_export_change = pi_exports iface == pi_exports new_iface
+
+    new_mod_vers | no_output_change = mod_vers
+		 | otherwise  	    = bumpVersion mod_vers
+
+    mod_vers = pi_vers iface
+
+    (fixity_vers, fixities) = pi_fixity iface
+    (_,       new_fixities) = pi_fixity new_iface
+    new_fixity_vers | fixities == new_fixities = fixity_vers
+		    | otherwise		       = bumpVersion fixity_vers
+
+    (rules_vers, rules) = pi_rules iface
+    (_,      new_rules) = pi_rules new_iface
+    new_rules_vers  | rules == new_rules = rules_vers
+		    | otherwise		 = bumpVersion rules_vers
+
+    (no_decl_changed, final_decls) = merge_decls True [] (pi_decls iface) (pi_decls new_iface)
+
+	-- Fill in the version number on the new declarations
+	-- by looking at the old declarations.
+	-- Set the flag if anything changes. 
+	-- Assumes that the decls are sorted by hsDeclName
+    merge_decls ok_so_far acc []  []        = (ok_so_far, reverse acc)
+    merge_decls ok_so_far acc old []        = (False, reverse acc)
+    merge_decls ok_so_far acc [] (nvd:nvds) = merge_decls False (nvd:acc) [] nvds
+    merge_decls ok_so_far acc (vd@(v,d):vds) (nvd@(_,nd):nvds)
+	= case d_name `compare` nd_name of
+		LT -> merge_decls False acc       vds      (nvd:nvds)
+		GT -> merge_decls False (nvd:acc) (vd:vds) nvds
+		EQ | d == nd   -> merge_decls ok_so_far (vd:acc) vds nvds
+		   | otherwise -> merge_decls False	((bumpVersion v, nd):acc) vds nvds
+	where
+ 	  d_name  = hsDeclName d
+ 	  nd_name = hsDeclName nd
+\end{code}
+
+
+
+%************************************************************************
+%*				 					*
+\subsection{Printing the interface}
+%*				 					*
+%************************************************************************
 
-endIface Nothing	= return ()
-endIface (Just if_hdl)	= hPutStr if_hdl "\n" >> hClose if_hdl
+\begin{code}
+pprIface (ParsedIface { pi_mod = mod, pi_vers = mod_vers, pi_orphan = orphan,
+			pi_usages = usages, pi_exports = exports, 
+			pi_fixity = (fix_vers, fixities),
+			pi_insts = insts, pi_decls = decls, 
+			pi_rules = (rule_vers, rules), pi_deprecs = deprecs })
+ = vcat [ ptext SLIT("__interface")
+		<+> doubleQuotes (ptext opt_InPackage)
+		<+> ppr mod <+> ppr mod_vers <+> pp_sub_vers
+		<+> (if orphan then char '!' else empty)
+		<+> int opt_HiVersion
+		<+> ptext SLIT("where")
+	, vcat (map pprExport exports)
+	, vcat (map pprUsage usages)
+	, pprFixities fixities
+	, vcat [ppr i <+> semi | i <- insts]
+	, vcat [ppr_vers v <+> ppr d <> semi | (v,d) <- decls]
+	, pprRules rules
+	, pprDeprecs deprecs
+	]
+  where
+    ppr_vers v | v == initialVersion = empty
+	       | otherwise	     = int v
+    pp_sub_vers 
+	| fix_vers == initialVersion && rule_vers == initialVersion = empty
+	| otherwise = brackets (ppr fix_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}
-ifaceDecls Nothing tycons classes inst_info final_ids simplified rules _ = return ()
-ifaceDecls (Just hdl)
-	   tycons classes
-	   inst_infos
-	   final_ids
-	   binds
-	   orphan_rules		-- Rules defined locally for an Id that is *not* defined locally
-	   deprecations
-  | null_decls = return ()		 
-	--  You could have a module with just (re-)exports/instances in it
-  | otherwise
-  = ifaceClasses hdl classes			>>
-    ifaceInstances hdl inst_infos		>>= \ inst_ids ->
-    ifaceTyCons hdl tycons			>>
-    ifaceBinds hdl (inst_ids `unionVarSet` orphan_rule_ids)
-	       final_ids binds			>>= \ emitted_ids ->
-    ifaceRules hdl orphan_rules emitted_ids	>>
-    ifaceDeprecations hdl deprecations
+pprExport :: ExportItem -> SDoc
+pprExport (mod, items)
+ = hsep [ ptext SLIT("__export "), ppr mod, hsep (map upp_avail items) ] <> semi
   where
-     orphan_rule_ids = unionVarSets [ ruleSomeFreeVars interestingId rule 
-				    | ProtoCoreRule _ _ rule <- orphan_rules]
-
-     null_decls = null binds		&& 
-		  null tycons		&&
-	          null classes		&& 
-	          isEmptyBag inst_infos	&&
-		  null orphan_rules	&&
-		  null deprecations
+    upp_avail :: RdrAvailInfo -> SDoc
+    upp_avail (Avail name)      = pprOccName name
+    upp_avail (AvailTC name []) = empty
+    upp_avail (AvailTC name ns) = hcat [pprOccName name, bang, upp_export ns']
+				where
+				  bang | name `elem` ns = empty
+				       | otherwise	= char '|'
+				  ns' = filter (/= name) ns
+    
+    upp_export []    = empty
+    upp_export names = braces (hsep (map pprOccName names))
 \end{code}
 
+
 \begin{code}
-ifaceImports :: Handle -> VersionInfo Name -> IO ()
-ifaceImports if_hdl import_usages
-  = hPutCol if_hdl upp_uses (sortLt lt_imp_vers import_usages)
+pprUsage :: ImportVersion OccName -> SDoc
+pprUsage (m, has_orphans, is_boot, whats_imported)
+  = hsep [ptext SLIT("import"), pprModuleName m, 
+	  pp_orphan, pp_boot,
+	  upp_import_versions whats_imported
+    ] <> semi
   where
-    upp_uses (m, mv, has_orphans, is_boot, whats_imported)
-      = hsep [ptext SLIT("import"), pprModuleName m, 
-	      int mv, pp_orphan, pp_boot,
-	      upp_import_versions whats_imported
-	] <> semi
-      where
-	pp_orphan | has_orphans = ptext SLIT("!")
-		  | otherwise   = empty
-        pp_boot   | is_boot     = ptext SLIT("@")
-                  | otherwise   = empty
+    pp_orphan | has_orphans = char '!'
+	      | otherwise   = empty
+    pp_boot   | is_boot     = char '@'
+              | otherwise   = empty
 
 	-- Importing the whole module is indicated by an empty list
-    upp_import_versions Everything = empty
-
-	-- For imported versions we do print the version number
-    upp_import_versions (Specifically nvs)
-      = dcolon <+> hsep [ hsep [ppr_unqual_name n, int v] | (n,v) <- sort_versions nvs ]
-
-{- SUP: What's this??
-ifaceModuleDeps if_hdl [] = return ()
-ifaceModuleDeps if_hdl mod_deps
-  = let 
-	lines = map ppr_mod_dep mod_deps
-	ppr_mod_dep (mod, contains_orphans) 
-	   | contains_orphans = pprModuleName mod <+> ptext SLIT("!")
-	   | otherwise	      = pprModuleName mod
-    in 
-    printForIface if_hdl (ptext SLIT("__depends") <+> vcat lines <> ptext SLIT(" ;")) >>
-    hPutStr if_hdl "\n"
--}
+    upp_import_versions NothingAtAll   = empty
+    upp_import_versions (Everything v) = dcolon <+> int v
+    upp_import_versions (Specifically vm vf vr nvs)
+      = dcolon <+> int vm <+> int vf <+> int vr <+> hsep [ ppr n <+> int v | (n,v) <- nvs ]
+\end{code}
 
-ifaceExports :: Handle -> Avails -> IO ()
-ifaceExports if_hdl [] = return ()
-ifaceExports if_hdl avails
-  = hPutCol if_hdl do_one_module (fmToList export_fm)
-  where
-	-- Sort them into groups by module
-    export_fm :: FiniteMap Module [AvailInfo]
-    export_fm = foldr insert emptyFM avails
-
-    insert avail efm = addToFM_C (++) efm mod [avail] 
-		     where
-		       mod = nameModule (availName avail)
-
-	-- Print one module's worth of stuff
-    do_one_module :: (Module, [AvailInfo]) -> SDoc
-    do_one_module (mod_name, avails@(avail1:_))
-	= ptext SLIT("__export ") <>
-	  hsep [pprModule mod_name,
-		hsep (map upp_avail (sortLt lt_avail avails))
-	  ] <> semi
-
-ifaceFixities :: Handle -> Fixities -> IO ()
-ifaceFixities if_hdl [] = return ()
-ifaceFixities if_hdl fixities 
-  = hPutCol if_hdl upp_fixity fixities
-
-ifaceRules :: Handle -> [ProtoCoreRule] -> IdSet -> IO ()
-ifaceRules if_hdl rules emitted
-  |  opt_OmitInterfacePragmas 	-- Don't emit rules if we are suppressing
-				-- interface pragmas
-  || (null orphan_rule_pretties && null local_id_pretties)
-  = return ()
-  | otherwise
-  = printForIface if_hdl (vcat [
-		ptext SLIT("{-## __R"),
-		vcat orphan_rule_pretties,
-		vcat local_id_pretties,
-		ptext SLIT("##-}")
-       ])
-  where
-    orphan_rule_pretties =  [ pprCoreRule (Just fn) rule
-			    | ProtoCoreRule _ fn rule <- rules
-			    ]
-    local_id_pretties = [ pprCoreRule (Just fn) rule
- 		        | fn <- varSetElems emitted, 
-			  rule <- rulesRules (idSpecialisation fn),
-			  all (`elemVarSet` emitted) (varSetElems (ruleSomeLhsFreeVars interestingId rule))
-				-- Spit out a rule only if all its lhs free vars are emitted
-				-- This is a good reason not to do it when we emit the Id itself
-		        ]
-
-ifaceDeprecations :: Handle -> [Deprecation Name] -> IO ()
-ifaceDeprecations if_hdl [] = return ()
-ifaceDeprecations if_hdl deprecations
-  = printForIface if_hdl (vcat [
-		ptext SLIT("{-## __D"),
-		vcat [ pprIE ie <+> doubleQuotes (ppr txt) <> semi | Deprecation ie txt <- deprecations ],
-		ptext SLIT("##-}")
-       ])
+
+\begin{code}
+pprFixities []    = empty
+pprFixities fixes = hsep (map ppr fixes) <> semi
+
+pprRules []    = empty
+pprRules rules = hsep [ptext SLIT("{-## __R"), hsep (map ppr rules), ptext SLIT("##-}")]
+
+pprDeprecs []   = empty
+pprDeprecs deps = hsep [ ptext SLIT("{-## __D"), guts, ptext SLIT("##-}")]
+		where
+		  guts = hsep [ ppr ie <+> doubleQuotes (ppr txt) <> semi 
+			      | Deprecation ie txt _ <- deps ]
+\end{code}
+
+
+%************************************************************************
+%*				 					*
+\subsection{Completing the new interface}
+%*				 					*
+%************************************************************************
+
+\begin{code}
+completeIface new_iface local_tycons local_classes
+		        inst_info final_ids tidy_binds
+			tidy_orphan_rules
+  = new_iface { pi_decls = [(initialVersion,d) | d <- sortLt lt_decl all_decls],
+		pi_insts = sortLt lt_inst_decl inst_dcls,
+		pi_rules = (initialVersion, rule_dcls)
+    }
   where
-    pprIE (IEVar            n   ) = ppr n
-    pprIE (IEThingAbs       n   ) = ppr n
-    pprIE (IEThingAll       n   ) = hcat [ppr n, text "(..)"]
-    pprIE (IEThingWith      n ns) = ppr n <> parens (hcat (punctuate comma (map ppr ns)))
-    pprIE (IEModuleContents _   ) = empty
+     all_decls = cls_dcls ++ ty_dcls ++ bagToList val_dcls
+     (inst_dcls, inst_ids) = ifaceInstances inst_info
+     cls_dcls = map ifaceClass local_classes
+     ty_dcls  = map ifaceTyCon (filter (not . isWiredInName . getName) local_tycons)
+
+     (val_dcls, emitted_ids) = ifaceBinds (inst_ids `unionVarSet` orphan_rule_ids)
+					  final_ids tidy_binds
+
+     rule_dcls | opt_OmitInterfacePragmas = []
+	       | otherwise		  = ifaceRules tidy_orphan_rules emitted_ids
+
+     orphan_rule_ids = unionVarSets [ ruleSomeFreeVars interestingId rule 
+				    | ProtoCoreRule _ _ rule <- tidy_orphan_rules]
+
+lt_inst_decl (InstDecl _ _ _ dfun_id1 _) (InstDecl _ _ _ dfun_id2 _)
+   = dfun_id1 < dfun_id2
+	-- The dfuns are assigned names df1, df2, etc, 
+	-- in order of original textual
+	-- occurrence, and this makes as good a sort order as any
+
+lt_decl d1 d2 = hsDeclName d1 < hsDeclName d2
 \end{code}
 
+
 %************************************************************************
 %*				 					*
-\subsection{Instance declarations}
+\subsection{Completion stuff}
 %*				 					*
 %************************************************************************
 
+\begin{code}
+ifaceRules :: [ProtoCoreRule] -> IdSet -> [RdrNameRuleDecl]
+ifaceRules rules emitted
+  = orphan_rules ++ local_rules
+  where
+    orphan_rules = [ toHsRule fn rule | ProtoCoreRule _ fn rule <- rules ]
+    local_rules  = [ toHsRule fn rule
+ 		   | fn <- varSetElems emitted, 
+		     rule <- rulesRules (idSpecialisation fn),
+		     not (isBuiltinRule rule),
+				-- We can't print builtin rules in interface files
+				-- Since they are built in, an importing module
+				-- will have access to them anyway
+		     all (`elemVarSet` emitted) (varSetElems (ruleSomeLhsFreeVars interestingId rule))
+				-- Spit out a rule only if all its lhs free vars are emitted
+				-- This is a good reason not to do it when we emit the Id itself
+		   ]
+\end{code}
 
 \begin{code}			 
-ifaceInstances :: Handle -> Bag InstInfo -> IO IdSet		-- The IdSet is the needed dfuns
-ifaceInstances if_hdl inst_infos
-  | null togo_insts = return emptyVarSet		 
-  | otherwise 	    = hPutCol if_hdl pp_inst (sortLt lt_inst togo_insts) >>
-		      return needed_ids
-  where				 
+ifaceInstances :: Bag InstInfo -> ([RdrNameInstDecl], IdSet)
+		   -- The IdSet is the needed dfuns
+
+ifaceInstances inst_infos
+  = (decls, needed_ids)
+  where			
+    decls       = map to_decl togo_insts
     togo_insts	= filter is_togo_inst (bagToList inst_infos)
     needed_ids  = mkVarSet [dfun_id | InstInfo _ _ _ _ dfun_id _ _ _ <- togo_insts]
     is_togo_inst (InstInfo _ _ _ _ dfun_id _ _ _) = isLocallyDefined dfun_id
 				 
     -------			 
-    lt_inst (InstInfo _ _ _ _ dfun_id1 _ _ _)
-	    (InstInfo _ _ _ _ dfun_id2 _ _ _)
-      = getOccName dfun_id1 < getOccName dfun_id2
-	-- The dfuns are assigned names df1, df2, etc, in order of original textual
-	-- occurrence, and this makes as good a sort order as any
-
-    -------			 
-    pp_inst (InstInfo clas tvs tys theta dfun_id _ _ _)
+    to_decl (InstInfo clas tvs tys theta dfun_id _ _ _)
       = let			 
 		-- The deNoteType is very important.   It removes all type
 		-- synonyms from the instance type in interface files.
@@ -294,88 +385,217 @@ ifaceInstances if_hdl inst_infos
 		-- that mentioned T but not Tibble.
 	    forall_ty     = mkSigmaTy tvs (classesToPreds theta)
 				      (deNoteType (mkDictTy clas tys))
-	    renumbered_ty = tidyTopType forall_ty
+	    tidy_ty = tidyTopType forall_ty
 	in			 
-	hcat [ptext SLIT("instance "), pprType renumbered_ty, 
-		    ptext SLIT(" = "), ppr_unqual_name dfun_id, semi]
+	InstDecl (toHsType tidy_ty) EmptyMonoBinds [] (toRdrName dfun_id) noSrcLoc 
+\end{code}
+
+\begin{code}
+ifaceTyCon :: TyCon -> RdrNameHsDecl
+ifaceTyCon tycon
+  | isSynTyCon tycon
+  = TyClD (TySynonym (toRdrName tycon)
+		     (toHsTyVars tyvars) (toHsType ty)
+		     noSrcLoc)
+  where
+    (tyvars, ty) = getSynTyConDefn tycon
+
+ifaceTyCon tycon
+  | isAlgTyCon tycon
+  = TyClD (TyData new_or_data (toHsContext (tyConTheta tycon))
+		  (toRdrName tycon)
+		  (toHsTyVars tyvars)
+		  (map ifaceConDecl (tyConDataCons tycon))
+		  (tyConFamilySize tycon)
+		  Nothing NoDataPragmas noSrcLoc)
+  where
+    tyvars = tyConTyVars tycon
+    new_or_data | isNewTyCon tycon = NewType
+	        | otherwise	   = DataType
+
+    ifaceConDecl data_con 
+	= ConDecl (toRdrName data_con) (error "ifaceConDecl")
+		  (toHsTyVars ex_tyvars)
+		  (toHsContext ex_theta)
+		  details noSrcLoc
+	where
+	  (tyvars1, _, ex_tyvars, ex_theta, arg_tys, tycon1) = dataConSig data_con
+          field_labels   = dataConFieldLabels data_con
+          strict_marks   = dataConStrictMarks data_con
+	  details
+	    | null field_labels
+	    = ASSERT( tycon == tycon1 && tyvars == tyvars1 )
+	      VanillaCon (zipWith mk_bang_ty strict_marks arg_tys)
+
+    	    | otherwise
+	    = RecCon (zipWith mk_field strict_marks field_labels)
+
+    mk_bang_ty NotMarkedStrict     ty = Unbanged (toHsType ty)
+    mk_bang_ty (MarkedUnboxed _ _) ty = Unpacked (toHsType ty)
+    mk_bang_ty MarkedStrict        ty = Banged   (toHsType ty)
+
+    mk_field strict_mark field_label
+	= ([toRdrName field_label], mk_bang_ty strict_mark (fieldLabelType field_label))
+
+ifaceTyCon tycon
+  = pprPanic "pprIfaceTyDecl" (ppr tycon)
+
+ifaceClass clas
+  = TyClD (ClassDecl (toHsContext sc_theta)
+		     (toRdrName clas)
+		     (toHsTyVars clas_tyvars)
+		     (toHsFDs clas_fds)
+		     (map toClassOpSig op_stuff)
+		     EmptyMonoBinds NoClassPragmas
+		     bogus bogus bogus [] noSrcLoc
+    )
+  where
+     bogus = error "ifaceClass"
+     (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
+
+     toClassOpSig (sel_id, dm_id, explicit_dm)
+	= ASSERT( sel_tyvars == clas_tyvars)
+	  ClassOpSig (toRdrName sel_id) bogus explicit_dm (toHsType op_ty) noSrcLoc
+	where
+	  (sel_tyvars, _, op_ty) = splitSigmaTy (idType sel_id)
 \end{code}
 
 
 %************************************************************************
 %*				 					*
-\subsection{Printing values}
+\subsection{Value bindings}
 %*				 					*
 %************************************************************************
 
 \begin{code}
-ifaceId :: (Id -> IdInfo)		-- This function "knows" the extra info added
-					-- by the STG passes.  Sigh
+ifaceBinds :: IdSet		-- These Ids are needed already
+	   -> [Id]		-- Ids used at code-gen time; they have better pragma info!
+	   -> [CoreBind]	-- In dependency order, later depend on earlier
+	   -> (Bag RdrNameHsDecl, IdSet)		-- Set of Ids actually spat out
+
+ifaceBinds needed_ids final_ids binds
+  = go needed_ids (reverse binds) emptyBag emptyVarSet 
+		-- Reverse so that later things will 
+		-- provoke earlier ones to be emitted
+  where
+    final_id_map  = listToUFM [(id,id) | id <- final_ids]
+    get_idinfo id = case lookupUFM final_id_map id of
+			Just id' -> idInfo id'
+			Nothing  -> pprTrace "ifaceBinds not found:" (ppr id) $
+				    idInfo id
 
-	    -> IdSet			-- Set of Ids that are needed by earlier interface
-					-- file emissions.  If the Id isn't in this set, and isn't
-					-- exported, there's no need to emit anything
-	    -> Bool			-- True <=> recursive, so don't print unfolding
-	    -> Id
-	    -> CoreExpr			-- The Id's right hand side
-	    -> Maybe (SDoc, IdSet)	-- The emitted stuff, plus any *extra* needed Ids
+    go needed [] decls emitted
+	| not (isEmptyVarSet needed) = pprTrace "ifaceBinds: free vars:" 
+					  (sep (map ppr (varSetElems needed)))
+				       (decls, emitted)
+	| otherwise 		     = (decls, emitted)
+
+    go needed (NonRec id rhs : binds) decls emitted
+	= case ifaceId get_idinfo needed False id rhs of
+		Nothing		      -> go needed binds decls emitted
+		Just (decl, extras) -> let
+			needed' = (needed `unionVarSet` extras) `delVarSet` id
+			-- 'extras' can include the Id itself via a rule
+			emitted' = emitted `extendVarSet` id
+			in
+			go needed' binds (decl `consBag` decls) emitted'
+
+	-- Recursive groups are a bit more of a pain.  We may only need one to
+	-- start with, but it may call out the next one, and so on.  So we
+	-- have to look for a fixed point.
+    go needed (Rec pairs : binds) decls emitted
+	= go needed' binds decls' emitted' 
+	where
+	  (new_decls, new_emitted, extras) = go_rec needed pairs
+	  decls'   = new_decls `unionBags` decls
+	  needed'  = (needed `unionVarSet` extras) `minusVarSet` mkVarSet (map fst pairs) 
+	  emitted' = emitted `unionVarSet` new_emitted
+
+    go_rec :: IdSet -> [(Id,CoreExpr)] -> (Bag RdrNameHsDecl, IdSet, IdSet)
+    go_rec needed pairs
+	| null decls = (emptyBag, emptyVarSet, emptyVarSet)
+	| otherwise	= (more_decls `unionBags`   listToBag decls, 
+			   more_emitted  `unionVarSet` mkVarSet emitted,
+			   more_extras   `unionVarSet` extras)
+	where
+	  maybes	     = map do_one pairs
+	  emitted	     = [id   | ((id,_), Just _)  <- pairs `zip` maybes]
+	  reduced_pairs	     = [pair | (pair,   Nothing) <- pairs `zip` maybes]
+	  (decls, extras_s)  = unzip (catMaybes maybes)
+	  extras	     = unionVarSets extras_s
+	  (more_decls, more_emitted, more_extras) = go_rec extras reduced_pairs
+
+	  do_one (id,rhs) = ifaceId get_idinfo needed True id rhs
+\end{code}
+
+
+\begin{code}
+ifaceId :: (Id -> IdInfo)	-- This function "knows" the extra info added
+				-- by the STG passes.  Sigh
+
+	-> IdSet		-- Set of Ids that are needed by earlier interface
+				-- file emissions.  If the Id isn't in this set, and isn't
+				-- exported, there's no need to emit anything
+	-> Bool			-- True <=> recursive, so don't print unfolding
+	-> Id
+	-> CoreExpr		-- The Id's right hand side
+	-> Maybe (RdrNameHsDecl, IdSet)	-- The emitted stuff, plus any *extra* needed Ids
 
 ifaceId get_idinfo needed_ids is_rec id rhs
   | not (id `elemVarSet` needed_ids ||		-- Needed [no id in needed_ids has omitIfaceSigForId]
-	 (isUserExportedId id && not (omitIfaceSigForId id)))	-- or exported and not to be omitted
+	(isUserExportedId id && not (omitIfaceSigForId id)))	-- or exported and not to be omitted
   = Nothing 		-- Well, that was easy!
 
 ifaceId get_idinfo needed_ids is_rec id rhs
   = ASSERT2( arity_matches_strictness, ppr id )
-    Just (hsep [sig_pretty, prag_pretty, char ';'], new_needed_ids)
+    Just (SigD (IfaceSig (toRdrName id) (toHsType id_type) hs_idinfo noSrcLoc),
+	  new_needed_ids)
   where
+    id_type     = idType id
     core_idinfo = idInfo id
     stg_idinfo  = get_idinfo id
 
-    ty_pretty  = pprType (idType id)
-    sig_pretty = hsep [ppr (getOccName id), dcolon, ty_pretty]
-
-    prag_pretty 
-     | opt_OmitInterfacePragmas = empty
-     | otherwise		= hsep [ptext SLIT("{-##"),
-					arity_pretty, 
-					caf_pretty,
-					cpr_pretty,
-					strict_pretty,
-					wrkr_pretty,
-					unfold_pretty, 
-					ptext SLIT("##-}")]
+    hs_idinfo | opt_OmitInterfacePragmas = []
+ 	      | otherwise		 = arity_hsinfo  ++ caf_hsinfo  ++ cpr_hsinfo ++ 
+					   strict_hsinfo ++ wrkr_hsinfo ++ unfold_hsinfo
 
     ------------  Arity  --------------
-    arity_info    = arityInfo stg_idinfo
-    arity_pretty  = ppArityInfo arity_info
+    arity_info     = arityInfo stg_idinfo
+    arity_hsinfo = case arityInfo stg_idinfo of
+			a@(ArityExactly n) -> [HsArity a]
+			other		   -> []
 
     ------------ Caf Info --------------
-    caf_pretty = ppCafInfo (cafInfo stg_idinfo)
+    caf_hsinfo = case cafInfo stg_idinfo of
+		   NoCafRefs -> [HsNoCafRefs]
+		   otherwise -> []
 
     ------------ CPR Info --------------
-    cpr_pretty = ppCprInfo (cprInfo core_idinfo)
+    cpr_hsinfo = case cprInfo core_idinfo of
+		   ReturnsCPR -> [HsCprInfo]
+		   NoCPRInfo  -> []
 
     ------------  Strictness  --------------
     strict_info   = strictnessInfo core_idinfo
     bottoming_fn  = isBottomingStrictness strict_info
-    strict_pretty = ppStrictnessInfo strict_info
+    strict_hsinfo = case strict_info of
+			NoStrictnessInfo -> []
+			info		 -> [HsStrictness info]
+
 
     ------------  Worker  --------------
     work_info     = workerInfo core_idinfo
     has_worker    = workerExists work_info
-    wrkr_pretty   = ppWorkerInfo work_info
-    HasWorker work_id wrap_arity = work_info
-
-
-    ------------  Occ info  --------------
-    loop_breaker  = isLoopBreaker (occInfo core_idinfo)
+    wrkr_hsinfo   = case work_info of
+			HasWorker work_id _ -> [HsWorker (toRdrName work_id)]
+			other		    -> []
 
     ------------  Unfolding  --------------
     inline_pragma  = inlinePragInfo core_idinfo
     dont_inline	   = isNeverInlinePrag inline_pragma
 
-    unfold_pretty | show_unfold = ptext SLIT("__U") <> pprInlinePragInfo inline_pragma <+> pprIfaceUnfolding rhs
-		  | otherwise   = empty
+    unfold_hsinfo | show_unfold = [HsUnfold inline_pragma (toUfExpr rhs)]
+		  | otherwise   = []
 
     show_unfold = not has_worker	 &&	-- Not unnecessary
 		  not bottoming_fn	 &&	-- Not necessary
@@ -389,16 +609,20 @@ ifaceId get_idinfo needed_ids is_rec id rhs
     ------------  Specialisations --------------
     spec_info   = specInfo core_idinfo
     
+    ------------  Occ info  --------------
+    loop_breaker  = isLoopBreaker (occInfo core_idinfo)
+
     ------------  Extra free Ids  --------------
     new_needed_ids | opt_OmitInterfacePragmas = emptyVarSet
 	           | otherwise		      = worker_ids	`unionVarSet`
 						unfold_ids	`unionVarSet`
 						spec_ids
 
-    worker_ids | has_worker && interestingId work_id = unitVarSet work_id
+    worker_ids = case work_info of
+		   HasWorker work_id _ | interestingId work_id -> unitVarSet work_id
 			-- Conceivably, the worker might come from
 			-- another module
-	       | otherwise			   = emptyVarSet
+		   other -> emptyVarSet
 
     spec_ids = filterVarSet interestingId (rulesRhsFreeVars spec_info)
 
@@ -410,289 +634,12 @@ ifaceId get_idinfo needed_ids is_rec id rhs
     ------------ Sanity checking --------------
 	-- The arity of a wrapper function should match its strictness,
 	-- or else an importing module will get very confused indeed.
-    arity_matches_strictness = not has_worker || 
-			       wrap_arity == arityLowerBound arity_info
+    arity_matches_strictness 
+       = case work_info of
+	     HasWorker _ wrap_arity -> wrap_arity == arityLowerBound arity_info
+	     other		    -> True
     
 interestingId id = isId id && isLocallyDefined id &&
 		   not (omitIfaceSigForId id)
 \end{code}
 
-\begin{code}
-ifaceBinds :: Handle
-	   -> IdSet		-- These Ids are needed already
-	   -> [Id]		-- Ids used at code-gen time; they have better pragma info!
-	   -> [CoreBind]	-- In dependency order, later depend on earlier
-	   -> IO IdSet		-- Set of Ids actually spat out
-
-ifaceBinds hdl needed_ids final_ids binds
-  = mapIO (printForIface hdl) (bagToList pretties)	>>
-    hPutStr hdl "\n"					>>
-    return emitted
-  where
-    final_id_map  = listToUFM [(id,id) | id <- final_ids]
-    get_idinfo id = case lookupUFM final_id_map id of
-			Just id' -> idInfo id'
-			Nothing  -> pprTrace "ifaceBinds not found:" (ppr id) $
-				    idInfo id
-
-    (pretties, emitted) = go needed_ids (reverse binds) emptyBag emptyVarSet 
-			-- Reverse so that later things will 
-			-- provoke earlier ones to be emitted
-    go needed [] pretties emitted
-	| not (isEmptyVarSet needed) = pprTrace "ifaceBinds: free vars:" 
-					  (sep (map ppr (varSetElems needed)))
-				       (pretties, emitted)
-	| otherwise 		     = (pretties, emitted)
-
-    go needed (NonRec id rhs : binds) pretties emitted
-	= case ifaceId get_idinfo needed False id rhs of
-		Nothing		      -> go needed binds pretties emitted
-		Just (pretty, extras) -> let
-			needed' = (needed `unionVarSet` extras) `delVarSet` id
-			-- 'extras' can include the Id itself via a rule
-			emitted' = emitted `extendVarSet` id
-			in
-			go needed' binds (pretty `consBag` pretties) emitted'
-
-	-- Recursive groups are a bit more of a pain.  We may only need one to
-	-- start with, but it may call out the next one, and so on.  So we
-	-- have to look for a fixed point.
-    go needed (Rec pairs : binds) pretties emitted
-	= go needed' binds pretties' emitted' 
-	where
-	  (new_pretties, new_emitted, extras) = go_rec needed pairs
-	  pretties' = new_pretties `unionBags` pretties
-	  needed'   = (needed `unionVarSet` extras) `minusVarSet` mkVarSet (map fst pairs) 
-	  emitted'  = emitted `unionVarSet` new_emitted
-
-    go_rec :: IdSet -> [(Id,CoreExpr)] -> (Bag SDoc, IdSet, IdSet)
-    go_rec needed pairs
-	| null pretties = (emptyBag, emptyVarSet, emptyVarSet)
-	| otherwise	= (more_pretties `unionBags`   listToBag pretties, 
-			   more_emitted  `unionVarSet` mkVarSet emitted,
-			   more_extras   `unionVarSet` extras)
-	where
-	  maybes	       = map do_one pairs
-	  emitted	       = [id   | ((id,_), Just _)  <- pairs `zip` maybes]
-	  reduced_pairs	       = [pair | (pair,   Nothing) <- pairs `zip` maybes]
-	  (pretties, extras_s) = unzip (catMaybes maybes)
-	  extras	       = unionVarSets extras_s
-	  (more_pretties, more_emitted, more_extras) = go_rec extras reduced_pairs
-
-	  do_one (id,rhs) = ifaceId get_idinfo needed True id rhs
-\end{code}
-
-
-%************************************************************************
-%*				 					*
-\subsection{Random small things}
-%*				 					*
-%************************************************************************
-
-\begin{code}
-ifaceTyCons hdl tycons   = hPutCol hdl upp_tycon (sortLt (<) (filter (for_iface_name . getName) tycons))
-ifaceClasses hdl classes = hPutCol hdl upp_class (sortLt (<) (filter (for_iface_name . getName) classes))
-
-for_iface_name name = isLocallyDefined name && 
-		      not (isWiredInName name)
-
-upp_tycon tycon = ifaceTyCon tycon
-upp_class clas  = ifaceClass clas
-\end{code}
-
-
-\begin{code}
-ifaceTyCon :: TyCon -> SDoc
-ifaceTyCon tycon
-  | isSynTyCon tycon
-  = hsep [ ptext SLIT("type"),
-	   ppr (getName tycon),
-	   pprTyVarBndrs tyvars,
-	   ptext SLIT("="),
-	   ppr ty,
-	   semi
-    ]
-  where
-    (tyvars, ty) = getSynTyConDefn tycon
-
-ifaceTyCon tycon
-  | isAlgTyCon tycon
-  = hsep [ ptext keyword,
-	   ppr_decl_class_context (tyConTheta tycon),
-	   ppr (getName tycon),
-	   pprTyVarBndrs (tyConTyVars tycon),
-	   ptext SLIT("="),
-	   hsep (punctuate (ptext SLIT(" | ")) (map ppr_con (tyConDataCons tycon))),
-	   semi
-    ]
-  where
-    keyword | isNewTyCon tycon = SLIT("newtype")
-	    | otherwise	       = SLIT("data")
-
-    tyvars = tyConTyVars tycon
-
-    ppr_con data_con 
-	| null field_labels
-	= ASSERT( tycon == tycon1 && tyvars == tyvars1 )
-	  hsep [  ppr_ex ex_tyvars ex_theta,
-		  ppr name,
-		  hsep (map ppr_arg_ty (strict_marks `zip` arg_tys))
-	        ]
-
-	| otherwise
-	= hsep [  ppr_ex ex_tyvars ex_theta,
-		  ppr name,
-		  braces $ hsep $ punctuate comma (map ppr_field (strict_marks `zip` field_labels))
-	 	]
-          where
-	   (tyvars1, _, ex_tyvars, ex_theta, arg_tys, tycon1) = dataConSig data_con
-           field_labels   = dataConFieldLabels data_con
-           strict_marks   = dataConStrictMarks data_con
-	   name           = getName            data_con
-
-    ppr_ex [] ex_theta = ASSERT( null ex_theta ) empty
-    ppr_ex ex_tvs ex_theta = ptext SLIT("__forall") <+> brackets (pprTyVarBndrs ex_tvs)
-			     <+> pprIfaceClasses ex_theta <+> ptext SLIT("=>")
-
-    ppr_arg_ty (strict_mark, ty) = ppr_strict_mark strict_mark <> pprParendType ty
-
-    ppr_strict_mark NotMarkedStrict        = empty
-    ppr_strict_mark (MarkedUnboxed _ _)    = ptext SLIT("! ! ")
-    ppr_strict_mark MarkedStrict           = ptext SLIT("! ")
-
-    ppr_field (strict_mark, field_label)
-	= hsep [ ppr (fieldLabelName field_label),
-		  dcolon,
-		  ppr_strict_mark strict_mark <> pprParendType (fieldLabelType field_label)
-		]
-
-ifaceTyCon tycon
-  = pprPanic "pprIfaceTyDecl" (ppr tycon)
-
-ifaceClass clas
-  = hsep [ptext SLIT("class"),
-	   ppr_decl_class_context sc_theta,
-	   ppr clas,			-- Print the name
-	   pprTyVarBndrs clas_tyvars,
-	   pprFundeps clas_fds,
-	   pp_ops,
-	   semi
-	  ]
-   where
-     (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
-
-     pp_ops | null op_stuff  = empty
-	    | otherwise      = hsep [ptext SLIT("where"),
-				     braces (hsep (punctuate semi (map ppr_classop op_stuff)))
-			       ]
-
-     ppr_classop (sel_id, dm_id, explicit_dm)
-	= ASSERT( sel_tyvars == clas_tyvars)
-	  hsep [ppr (getOccName sel_id),
-		if explicit_dm then equals else empty,
-	        dcolon,
-		ppr op_ty
-	  ]
-	where
-	  (sel_tyvars, _, op_ty) = splitSigmaTy (idType sel_id)
-
-ppr_decl_context :: ThetaType -> SDoc
-ppr_decl_context []    = empty
-ppr_decl_context theta = pprIfaceTheta theta <+> ptext SLIT(" =>")
-
-ppr_decl_class_context :: ClassContext -> SDoc
-ppr_decl_class_context []    = empty
-ppr_decl_class_context ctxt  = pprIfaceClasses ctxt <+> ptext SLIT(" =>")
-
-pprIfaceTheta :: ThetaType -> SDoc	-- Use braces rather than parens in interface files
-pprIfaceTheta []    = empty
-pprIfaceTheta theta = braces (hsep (punctuate comma [pprIfacePred p | p <- theta]))
-
--- ZZ - not sure who uses this - i.e. whether IParams really show up or not
--- (it's not used to print normal value signatures)
-pprIfacePred :: PredType -> SDoc
-pprIfacePred (Class clas tys) = pprConstraint clas tys
-pprIfacePred (IParam n ty)    = char '?' <> ppr n <+> ptext SLIT("::") <+> ppr ty
-
-pprIfaceClasses :: ClassContext -> SDoc
-pprIfaceClasses []    = empty
-pprIfaceClasses theta = braces (hsep (punctuate comma [pprConstraint c tys | (c,tys) <- theta]))
-\end{code}
-
-%************************************************************************
-%*				 					*
-\subsection{Random small things}
-%*				 					*
-%************************************************************************
-
-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}
-upp_avail :: AvailInfo -> SDoc
-upp_avail (Avail name)      = pprOccName (getOccName name)
-upp_avail (AvailTC name []) = empty
-upp_avail (AvailTC name ns) = hcat [pprOccName (getOccName name), bang, upp_export ns']
-			    where
-			      bang | name `elem` ns = empty
-				   | otherwise	    = char '|'
-			      ns' = filter (/= name) ns
-
-upp_export :: [Name] -> SDoc
-upp_export []    = empty
-upp_export names = braces (hsep (map (pprOccName . getOccName) names)) 
-
-upp_fixity :: (Name, Fixity) -> SDoc
-upp_fixity (name, fixity) = hsep [ptext SLIT("0"), ppr fixity, ppr name, semi]
-	-- Dummy version number!
-
-ppr_unqual_name :: NamedThing a => a -> SDoc		-- Just its occurrence name
-ppr_unqual_name name = pprOccName (getOccName name)
-\end{code}
-
-
-%************************************************************************
-%*				 					*
-\subsection{Comparisons}
-%*				 					*
-%************************************************************************
-				 
-
-The various sorts above simply prevent unnecessary "wobbling" when
-things change that don't have to.  We therefore compare lexically, not
-by unique
-
-\begin{code}
-lt_avail :: AvailInfo -> AvailInfo -> Bool
-
-a1 `lt_avail` a2 = availName a1 `lt_name` availName a2
-
-lt_name :: Name -> Name -> Bool
-n1 `lt_name` n2 = nameRdrName n1 < nameRdrName n2
-
-lt_lexical :: NamedThing a => a -> a -> Bool
-lt_lexical a1 a2 = getName a1 `lt_name` getName a2
-
-lt_imp_vers :: ImportVersion a -> ImportVersion a -> Bool
-lt_imp_vers (m1,_,_,_,_) (m2,_,_,_,_) = m1 < m2
-
-sort_versions vs = sortLt lt_vers vs
-
-lt_vers :: LocalVersion Name -> LocalVersion Name -> Bool
-lt_vers (n1,v1) (n2,v2) = n1 `lt_name` n2
-\end{code}
-
-
-\begin{code}
-hPutCol :: Handle 
-	-> (a -> SDoc)
-	-> [a]
-	-> IO ()
-hPutCol hdl fmt xs = mapIO (printForIface hdl . fmt) xs
-
-mapIO :: (a -> IO b) -> [a] -> IO ()
-mapIO f []     = return ()
-mapIO f (x:xs) = f x >> mapIO f xs
-\end{code}