X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FMkIface.lhs;h=15bb56964489af51a94c6d5ae6910481c37afb96;hb=1fb1ab5d53a09607e7f6d2450806760688396387;hp=796d51d0cbb89e7deeed5170d83bacb8236c004d;hpb=68afb16743cafd5b7495771d359891c6dfc5a186;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 796d51d..15bb569 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
 %
 \section[MkIface]{Print an interface for a module}
 
@@ -8,68 +8,66 @@
 
 module MkIface (
 	startIface, endIface,
-	ifaceUsages,
-	ifaceVersions,
-	ifaceExportList,
-	ifaceFixities,
-	ifaceInstanceModules,
-	ifaceDecls,
-	ifaceInstances,
-	ifacePragmas
+	ifaceMain,
+	ifaceDecls
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
+IMPORT_1_3(IO(Handle,hPutStr,openFile,hClose,IOMode(..)))
 
-import Bag		( emptyBag, snocBag, bagToList )
-import Class		( GenClass(..){-instance NamedThing-}, GenClassOp(..) )
-import CmdLineOpts	( opt_ProduceHi )
-import FieldLabel	( FieldLabel{-instance NamedThing-} )
-import FiniteMap	( fmToList )
 import HsSyn
-import Id		( idType, dataConSig, dataConFieldLabels,
-			  dataConStrictMarks, StrictnessMark(..),
+import RdrHsSyn		( RdrName(..) )
+import RnHsSyn		( SYN_IE(RenamedHsModule) )
+import RnMonad
+import RnEnv		( availName )
+
+import TcInstUtil	( InstInfo(..) )
+
+import CmdLineOpts
+import Id		( idType, dataConRawArgTys, dataConFieldLabels, isDataCon,
+			  getIdInfo, idWantsToBeINLINEd, omitIfaceSigForId,
+			  dataConStrictMarks, StrictnessMark(..), 
+			  SYN_IE(IdSet), idSetToList, unionIdSets, unitIdSet, minusIdSet, 
+			  isEmptyIdSet, elementOfIdSet, emptyIdSet, mkIdSet,
 			  GenId{-instance NamedThing/Outputable-}
 			)
-import Name		( nameOrigName, origName, nameOf,
-			  exportFlagOn, nameExportFlag, ExportFlag(..),
-			  ltLexical, isExported, getExportFlag,
-			  isLexSym, isLocallyDefined,
-			  RdrName(..){-instance Outputable-},
-			  Name{-instance NamedThing-}
+import IdInfo		( StrictnessInfo, ArityInfo, Unfolding,
+			  arityInfo, ppArityInfo, strictnessInfo, ppStrictnessInfo, 
+			  getWorkerId_maybe, bottomIsGuaranteed 
+			)
+import CoreSyn		( SYN_IE(CoreExpr), SYN_IE(CoreBinding), GenCoreExpr, GenCoreBinding(..) )
+import CoreUnfold	( calcUnfoldingGuidance, UnfoldingGuidance(..) )
+import FreeVars		( addExprFVs )
+import Name		( isLocallyDefined, isWiredInName, modAndOcc, getName, pprOccName,
+			  OccName, occNameString, nameOccName, nameString, isExported, pprNonSym,
+			  Name {-instance NamedThing-}, Provenance
 			)
-import ParseUtils	( UsagesMap(..), VersionsMap(..) )
+import TyCon		( TyCon{-instance NamedThing-} )
+import Class		( GenClass(..){-instance NamedThing-}, GenClassOp, classOpLocalType )
+import FieldLabel	( FieldLabel{-instance NamedThing-} )
+import Type		( mkSigmaTy, mkDictTy, getAppTyCon, splitForAllTy )
+import TyVar		( GenTyVar {- instance Eq -} )
+import Unique		( Unique {- instance Eq -} )
+
 import PprEnv		-- not sure how much...
 import PprStyle		( PprStyle(..) )
-import PprType		-- most of it (??)
-import Pretty		-- quite a bit
-import RnHsSyn		( RenamedHsModule(..), RnName{-instance NamedThing-} )
-import TcModule		( TcIfaceInfo(..) )
-import TcInstUtil	( InstInfo(..) )
-import TyCon		( TyCon(..){-instance NamedThing-}, NewOrData(..) )
-import Type		( mkSigmaTy, mkDictTy, getAppTyCon )
-import Util		( sortLt, zipWithEqual, zipWith3Equal, assertPanic, panic{-ToDo:rm-}, pprTrace{-ToDo:rm-} )
-
-ppSemid    x = ppBeside (ppr PprInterface x) ppSemi -- micro util
-ppr_ty	  ty = pprType PprInterface ty
-ppr_tyvar tv = ppr PprInterface tv
-ppr_name   n
-  = let
-	on = origName n
-	s  = nameOf  on
-	pp = ppr PprInterface on
-    in
-    (if isLexSym s then ppParens else id) pp
-ppr_unq_name n
-  = let
-	on = origName n
-	s  = nameOf  on
-	pp = ppPStr   s
-    in
-    (if isLexSym s then ppParens else id) pp
+import PprType
+import PprCore		( pprIfaceUnfolding )
+import Pretty
+import Unpretty		-- ditto
+
+
+import Bag		( bagToList )
+import Maybes		( catMaybes, maybeToBool )
+import FiniteMap	( emptyFM, addToFM, addToFM_C, lookupFM, fmToList, eltsFM, FiniteMap )
+import UniqFM		( UniqFM, lookupUFM, listToUFM )
+import Util		( sortLt, zipWithEqual, zipWith3Equal, mapAccumL,
+			  assertPanic, panic{-ToDo:rm-}, pprTrace )
+
 \end{code}
 
 We have a function @startIface@ to open the output file and put
-(something like) ``interface Foo N'' in it.  It gives back a handle
+(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.,
@@ -79,38 +77,20 @@ to the handle provided by @startIface@.
 \begin{code}
 startIface  :: Module
 	    -> IO (Maybe Handle) -- Nothing <=> don't do an interface
-endIface    :: Maybe Handle -> IO ()
-ifaceUsages
-	    :: Maybe Handle
-	    -> UsagesMap
-	    -> IO ()
-ifaceVersions
-	    :: Maybe Handle
-	    -> VersionsMap
-	    -> IO ()
-ifaceExportList
-	    :: Maybe Handle
-	    -> RenamedHsModule
-	    -> IO ()
-ifaceFixities
-	    :: Maybe Handle
-	    -> RenamedHsModule
-	    -> IO ()
-ifaceInstanceModules
-	    :: Maybe Handle
-	    -> [Module]
-	    -> IO ()
-ifaceDecls  :: Maybe Handle
-	    -> TcIfaceInfo  -- info produced by typechecker, for interfaces
-	    -> IO ()
-ifaceInstances
-	    :: Maybe Handle
-	    -> TcIfaceInfo  -- as above
-	    -> IO ()
-ifacePragmas
-	    :: Maybe Handle
+
+ifaceMain   :: Maybe Handle
+	    -> InterfaceDetails
 	    -> IO ()
-ifacePragmas = panic "ifacePragmas" -- stub
+
+
+ifaceDecls :: Maybe Handle
+	   -> RenamedHsModule
+	   -> Bag InstInfo 
+	   -> [Id]		-- Ids used at code-gen time; they have better pragma info!
+	   -> [CoreBinding]	-- In dependency order, later depend on earlier
+	   -> IO ()
+
+endIface    :: Maybe Handle -> IO ()
 \end{code}
 
 \begin{code}
@@ -119,325 +99,373 @@ startIface mod
       Nothing -> return Nothing -- not producing any .hi file
       Just fn ->
 	openFile fn WriteMode	>>= \ if_hdl ->
-	hPutStr if_hdl ("interface "++ _UNPK_ mod ++" 1\n") >>
+	hPutStr if_hdl ("{-# GHC_PRAGMA INTERFACE VERSION 20 #-}\n_interface_ "++ _UNPK_ mod ++ "\n") >>
 	return (Just if_hdl)
 
 endIface Nothing	= return ()
 endIface (Just if_hdl)	= hPutStr if_hdl "\n" >> hClose if_hdl
 \end{code}
 
-\begin{code}
-ifaceUsages Nothing{-no iface handle-} _ = return ()
 
-ifaceUsages (Just if_hdl) usages
-  | null usages_list
-  = return ()
+\begin{code}
+ifaceMain Nothing iface_stuff = return ()
+ifaceMain (Just if_hdl)
+	  (import_usages, ExportEnv avails fixities, instance_modules)
+  =
+    ifaceInstanceModules	if_hdl instance_modules		>>
+    ifaceUsages			if_hdl import_usages		>>
+    ifaceExports		if_hdl avails			>>
+    ifaceFixities		if_hdl fixities			>>
+    return ()
+
+ifaceDecls Nothing rn_mod inst_info final_ids simplified = return ()
+ifaceDecls (Just hdl)
+	   (HsModule _ _ _ _ _ decls _)
+	   inst_infos
+	   final_ids binds
+  | null decls = return ()		 
+	--  You could have a module with just (re-)exports/instances in it
   | otherwise
-  = hPutStr if_hdl "__usages__\n"   >>
-    hPutStr if_hdl (ppShow 10000 (ppAboves (map pp_uses usages_list)))
-  where
-    usages_list = fmToList usages
-
-    pp_uses (m, (mv, versions))
-      = ppBesides [ppPStr m, ppSP, ppInt mv, ppPStr SLIT(" :: "),
-	       pp_versions (fmToList versions), ppSemi]
+  = ifaceInstances hdl inst_infos		>>= \ needed_ids ->
+    hPutStr hdl "_declarations_\n"		>>
+    ifaceTCDecls hdl decls			>>
+    ifaceBinds hdl needed_ids final_ids binds	>>
+    return ()
 \end{code}
 
 \begin{code}
-ifaceVersions Nothing{-no iface handle-} _ = return ()
-
-ifaceVersions (Just if_hdl) version_info
-  | null version_list
-  = return ()
-  | otherwise
-  = hPutStr if_hdl "\n__versions__\n"	>>
-    hPutStr if_hdl (ppShow 10000 (pp_versions version_list))
+ifaceUsages if_hdl import_usages
+  = hPutStr if_hdl "_usages_\n"   >>
+    hPutCol if_hdl upp_uses (sortLt lt_imp_vers import_usages)
   where
-    version_list = fmToList version_info
+    upp_uses (m, mv, versions)
+      = uppBesides [upp_module m, uppSP, uppInt mv, uppPStr SLIT(" :: "),
+		    upp_import_versions (sort_versions versions), uppSemi]
 
-pp_versions nvs
-  = ppInterleave ppComma [ ppCat [ppPStr n, ppInt v] | (n,v) <- nvs ]
-\end{code}
+	-- For imported versions we do print the version number
+    upp_import_versions nvs
+      = uppIntersperse uppSP [ uppCat [ppr_unqual_name n, uppInt v] | (n,v) <- nvs ]
 
-\begin{code}
-ifaceInstanceModules Nothing{-no iface handle-} _ = return ()
-ifaceInstanceModules (Just _)		       [] = return ()
 
-ifaceInstanceModules (Just if_hdl) imods
-  = hPutStr if_hdl "\n__instance_modules__\n" >>
-    hPutStr if_hdl (ppShow 100 (ppCat (map ppPStr imods)))
-\end{code}
+ifaceInstanceModules if_hdl [] = return ()
+ifaceInstanceModules if_hdl imods
+  = hPutStr if_hdl "_instance_modules_\n" >>
+    hPutStr if_hdl (uppShow 0 (uppCat (map uppPStr imods))) >>
+    hPutStr if_hdl "\n"
 
-Export list: grab the Names of things that are marked Exported, sort
-(so the interface file doesn't ``wobble'' from one compilation to the
-next...), and print.  Note that the ``module'' now contains all the
-imported things that we are dealing with, thus including any entities
-that we are re-exporting from somewhere else.
-\begin{code}
-ifaceExportList Nothing{-no iface handle-} _ = return ()
-
-ifaceExportList (Just if_hdl)
-		(HsModule _ _ _ _ _ typedecls _ classdecls _ _ _ binds sigs _)
-  = let
-	name_flag_pairs :: Bag (Name, ExportFlag)
-	name_flag_pairs
-	  = foldr from_ty
-	   (foldr from_cls
-	   (foldr from_sig
-	   (from_binds binds emptyBag{-init accum-})
-	     sigs)
-	     classdecls)
-	     typedecls
-
-	sorted_pairs = sortLt lexical_lt (bagToList name_flag_pairs)
-
-    in
-    hPutStr if_hdl "\n__exports__\n" >>
-    hPutStr if_hdl (ppShow 100 (ppAboves (map pp_pair sorted_pairs)))
+ifaceExports if_hdl [] = return ()
+ifaceExports if_hdl avails
+  = hPutStr if_hdl "_exports_\n"			>>
+    hPutCol if_hdl do_one_module (fmToList export_fm)
   where
-    from_ty (TyData _ n _ _ _ _ _) acc = maybe_add acc n
-    from_ty (TyNew  _ n _ _ _ _ _) acc = maybe_add acc n
-    from_ty (TySynonym n _ _ _)	   acc = maybe_add acc n
-
-    from_cls (ClassDecl _ n _ _ _ _ _) acc = maybe_add acc n
+	-- Sort them into groups by module
+    export_fm :: FiniteMap Module [AvailInfo]
+    export_fm = foldr insert emptyFM avails
+
+    insert NotAvailable efm = efm
+    insert avail efm = addToFM_C (++) efm mod [avail] 
+		     where
+		       (mod,_) = modAndOcc (availName avail)
+
+	-- Print one module's worth of stuff
+    do_one_module (mod_name, avails)
+	= uppBesides [upp_module mod_name, uppSP, 
+		      uppCat (map upp_avail (sortLt lt_avail avails)),
+		      uppSemi]
+
+ifaceFixities if_hdl [] = return ()
+ifaceFixities if_hdl fixities 
+  = hPutStr if_hdl "_fixities_\n"		>>
+    hPutCol if_hdl upp_fixity fixities
+
+ifaceTCDecls if_hdl decls
+  =  hPutCol if_hdl ppr_decl tc_decls_for_iface
+  where
+    tc_decls_for_iface = sortLt lt_decl (filter for_iface decls)
+    for_iface decl@(ClD _) = for_iface_name (hsDeclName decl)
+    for_iface decl@(TyD _) = for_iface_name (hsDeclName decl)
+    for_iface other_decl   = False
 
-    from_sig (Sig n _ _ _) acc = maybe_add acc n
+    for_iface_name name = isLocallyDefined name && 
+			  not (isWiredInName name)
 
-    from_binds bs acc = maybe_add_list acc (collectTopLevelBinders bs)
+    lt_decl d1 d2 = hsDeclName d1 < hsDeclName d2
+\end{code}			 
 
-    --------------
-    maybe_add :: Bag (Name, ExportFlag) -> RnName -> Bag (Name, ExportFlag)
+%************************************************************************
+%*				 					*
+\subsection{Instance declarations}
+%*				 					*
+%************************************************************************
 
-    maybe_add acc rn
-      | exportFlagOn ef = acc `snocBag` (n, ef)
-      | otherwise       = acc
-      where
-	n  = getName rn
-	ef = nameExportFlag n
 
-    --------------
-    maybe_add_list acc []     = acc
-    maybe_add_list acc (n:ns) = maybe_add (maybe_add_list acc ns) n
+\begin{code}			 
+ifaceInstances :: Handle -> Bag InstInfo -> IO IdSet		-- The IdSet is the needed dfuns
+ifaceInstances if_hdl inst_infos
+  | null togo_insts = return emptyIdSet		 
+  | otherwise 	    = hPutStr if_hdl "_instances_\n" >>
+		      hPutCol if_hdl pp_inst (sortLt lt_inst togo_insts) >>
+		      return needed_ids
+  where				 
+    togo_insts	= filter is_togo_inst (bagToList inst_infos)
+    needed_ids  = mkIdSet [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 ty theta _ dfun_id _ _ _)
+      = let			 
+	    forall_ty     = mkSigmaTy tvs theta (mkDictTy clas ty)
+	    renumbered_ty = renumber_ty forall_ty
+	in			 
+	uppBesides [uppPStr SLIT("instance "), ppr_ty renumbered_ty, 
+		    uppPStr SLIT(" = "), ppr_unqual_name dfun_id, uppSemi]
+\end{code}
 
-    --------------
-    lexical_lt (n1,_) (n2,_) = nameOrigName n1 < nameOrigName n2
 
-    --------------
-    pp_pair (n, ef)
-      = ppBeside (ppr_name n) (pp_export ef)
-      where
-	pp_export ExportAll = ppPStr SLIT("(..)")
-	pp_export ExportAbs = ppNil
-\end{code}
+%************************************************************************
+%*				 					*
+\subsection{Printing values}
+%*				 					*
+%************************************************************************
 
 \begin{code}
-ifaceFixities Nothing{-no iface handle-} _ = return ()
-
-ifaceFixities (Just if_hdl) (HsModule _ _ _ _ fixities _ _ _ _ _ _ _ _ _)
-  = let
-	local_fixities = filter from_here fixities
-    in
-    if null local_fixities then
-	return ()
-    else 
-	hPutStr if_hdl "\n__fixities__\n" >>
-	hPutStr if_hdl (ppShow 100 (ppAboves (map ppSemid local_fixities)))
+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 (Pretty, IdSet)	-- The emitted stuff, plus a possibly-augmented set of needed Ids
+
+ifaceId get_idinfo needed_ids is_rec id rhs
+  | not (id `elementOfIdSet` needed_ids ||		-- Needed [no id in needed_ids has omitIfaceSigForId]
+	 (isExported 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
+  = Just (ppCat [sig_pretty, pp_double_semi, prag_pretty], new_needed_ids)
   where
-    from_here (InfixL v _) = isLocallyDefined v
-    from_here (InfixR v _) = isLocallyDefined v
-    from_here (InfixN v _) = isLocallyDefined v
+    pp_double_semi = ppPStr SLIT(";;")
+    idinfo         = get_idinfo id
+    inline_pragma  = idWantsToBeINLINEd id 
+
+    ty_pretty  = pprType PprInterface (initNmbr (nmbrType (idType id)))
+    sig_pretty = ppBesides [ppr PprInterface (getOccName id), ppPStr SLIT(" _:_ "), ty_pretty]
+
+    prag_pretty 
+     | opt_OmitInterfacePragmas = ppNil
+     | otherwise		= ppCat [arity_pretty, strict_pretty, unfold_pretty, pp_double_semi]
+
+    ------------  Arity  --------------
+    arity_pretty  = ppArityInfo PprInterface (arityInfo idinfo)
+
+    ------------  Strictness  --------------
+    strict_info   = strictnessInfo idinfo
+    maybe_worker  = getWorkerId_maybe strict_info
+    strict_pretty = ppStrictnessInfo PprInterface strict_info
+
+    ------------  Unfolding  --------------
+    unfold_pretty | show_unfold = ppCat [ppPStr SLIT("_U_"), pprIfaceUnfolding rhs]
+		  | otherwise   = ppNil
+
+    show_unfold = not implicit_unfolding && 			-- Unnecessary
+		  (inline_pragma || not dodgy_unfolding)	-- Dangerous
+
+    implicit_unfolding = maybeToBool maybe_worker ||
+			 bottomIsGuaranteed strict_info
+
+    dodgy_unfolding = is_rec ||					-- No recursive unfoldings please!
+		      case guidance of 				-- Too big to show
+			UnfoldNever -> True
+			other       -> False
+
+    guidance    = calcUnfoldingGuidance inline_pragma
+					opt_InterfaceUnfoldThreshold
+					rhs
+
+    
+    ------------  Extra free Ids  --------------
+    new_needed_ids = (needed_ids `minusIdSet` unitIdSet id)	`unionIdSets` 
+		     extra_ids
+
+    extra_ids | opt_OmitInterfacePragmas = emptyIdSet
+	      | otherwise		 = worker_ids	`unionIdSets`
+					   unfold_ids
+
+    worker_ids = case maybe_worker of
+			Just wkr -> unitIdSet wkr
+			Nothing  -> emptyIdSet
+
+    unfold_ids | show_unfold = free_vars
+	       | otherwise   = emptyIdSet
+			     where
+			       (_,free_vars) = addExprFVs interesting emptyIdSet rhs
+			       interesting bound id = isLocallyDefined id &&
+						      not (id `elementOfIdSet` bound) &&
+						      not (omitIfaceSigForId id)
 \end{code}
 
 \begin{code}
-ifaceDecls Nothing{-no iface handle-} _ = return ()
-
-ifaceDecls (Just if_hdl) (vals, tycons, classes, _)
-  = let
-	exported_classes = filter isExported classes
-	exported_tycons  = filter isExported tycons
-	exported_vals	 = filter isExported vals
-
-	sorted_classes   = sortLt ltLexical exported_classes
-	sorted_tycons	 = sortLt ltLexical exported_tycons
-	sorted_vals	 = sortLt ltLexical exported_vals
-    in
-    ASSERT(not (null exported_classes && null exported_tycons && null exported_vals))
-
-    hPutStr if_hdl "\n__declarations__\n" >>
-    hPutStr if_hdl (ppShow 100 (ppAboves [
-	ppAboves (map ppr_class sorted_classes),
-	ppAboves (map ppr_tycon sorted_tycons),
-	ppAboves [ppr_val v (idType v) | v <- sorted_vals]]))
-\end{code}
-
-\begin{code}
-ifaceInstances Nothing{-no iface handle-} _ = return ()
-
-ifaceInstances (Just if_hdl) (_, _, _, insts)
-  = let
-	exported_insts	= filter is_exported_inst (bagToList insts)
-
-	sorted_insts	= sortLt lt_inst exported_insts
-    in
-    if null exported_insts then
-	return ()
-    else
-	hPutStr if_hdl "\n__instances__\n" >>
-	hPutStr if_hdl (ppShow 100 (ppAboves (map pp_inst sorted_insts)))
+ifaceBinds :: Handle
+	   -> IdSet		-- These Ids are needed already
+	   -> [Id]		-- Ids used at code-gen time; they have better pragma info!
+	   -> [CoreBinding]	-- In dependency order, later depend on earlier
+	   -> IO ()
+
+ifaceBinds hdl needed_ids final_ids binds
+  = hPutStr hdl (uppShow 0 (prettyToUn (ppAboves pretties)))	>>
+    hPutStr hdl "\n"
   where
-    is_exported_inst (InstInfo clas _ ty _ _ _ _ _ from_here _ _ _)
-      = from_here -- && ...
-
-    -------
-    lt_inst (InstInfo clas1 _ ty1 _ _ _ _ _ _ _ _ _)
-	    (InstInfo clas2 _ ty2 _ _ _ _ _ _ _ _ _)
-      = let
-	    tycon1 = fst (getAppTyCon ty1)
-	    tycon2 = fst (getAppTyCon ty2)
-	in
-	case (origName clas1 `cmp` origName clas2) of
-	  LT_ -> True
-	  GT_ -> False
-	  EQ_ -> origName tycon1 < origName tycon2
-
-    -------
-    pp_inst (InstInfo clas tvs ty theta _ _ _ _ _ _ _ _)
-      = let
-	    forall_ty     = mkSigmaTy tvs theta (mkDictTy clas ty)
-	    renumbered_ty = initNmbr (nmbrType forall_ty)
-	in
-	ppBesides [ppPStr SLIT("instance "), ppr_ty renumbered_ty, ppSemi]
+    final_id_map  = listToUFM [(id,id) | id <- final_ids]
+    get_idinfo id = case lookupUFM final_id_map id of
+			Just id' -> getIdInfo id'
+			Nothing  -> pprTrace "ifaceBinds not found:" (ppr PprDebug id) $
+				    getIdInfo id
+
+    pretties = go needed_ids (reverse binds)	-- Reverse so that later things will 
+						-- provoke earlier ones to be emitted
+    go needed [] = if not (isEmptyIdSet needed) then
+			pprTrace "ifaceBinds: free vars:" 
+				  (ppSep (map (ppr PprDebug) (idSetToList needed))) $
+			[]
+		   else
+			[]
+
+    go needed (NonRec id rhs : binds)
+	= case ifaceId get_idinfo needed False id rhs of
+		Nothing		       -> go needed binds
+		Just (pretty, needed') -> pretty : go needed' binds
+
+	-- 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 ++ go needed'' binds
+	where
+	  (needed', pretties) = go_rec needed pairs
+	  needed'' = needed' `minusIdSet` mkIdSet (map fst pairs)
+		-- Later ones may spuriously cause earlier ones to be "needed" again
+
+    go_rec :: IdSet -> [(Id,CoreExpr)] -> (IdSet, [Pretty])
+    go_rec needed pairs
+	| null pretties = (needed, [])
+	| otherwise	= (final_needed, more_pretties ++ pretties)
+	where
+	  reduced_pairs		 	= [pair | (pair,Nothing) <- pairs `zip` maybes]
+	  pretties		 	= catMaybes maybes
+	  (needed', maybes)	 	= mapAccumL do_one needed pairs
+	  (final_needed, more_pretties) = go_rec needed' reduced_pairs
+
+	  do_one needed (id,rhs) = case ifaceId get_idinfo needed True id rhs of
+					Nothing		       -> (needed,  Nothing)
+					Just (pretty, needed') -> (needed', Just pretty)
 \end{code}
 
+
 %************************************************************************
-%*									*
-\subsection{Printing tycons, classes, ...}
-%*									*
+%*				 					*
+\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}
-ppr_class :: Class -> Pretty
-
-ppr_class c
-  = --pprTrace "ppr_class:" (ppr PprDebug c) $
-    case (initNmbr (nmbrClass c)) of { -- renumber it!
-      Class _ n tyvar super_classes sdsels ops sels defms insts links ->
-
-	ppAbove (ppCat [ppPStr SLIT("class"), ppr_theta tyvar super_classes,
-		    ppr_name n, ppr_tyvar tyvar,
-		    if null ops then ppSemi else ppStr "where {"])
-	    (if (null ops)
-	     then ppNil
-	     else ppAbove (ppNest 2 (ppAboves (map ppr_op ops)))
-			  (ppStr "};")
-	    )
-    }
-  where
-    ppr_theta :: TyVar -> [Class] -> Pretty
+upp_avail NotAvailable      = uppNil
+upp_avail (Avail name)      = upp_occname (getOccName name)
+upp_avail (AvailTC name []) = uppNil
+upp_avail (AvailTC name ns) = uppBesides [upp_occname (getOccName name), bang, upp_export ns']
+			    where
+			      bang | name `elem` ns = uppNil
+				   | otherwise	    = uppChar '!'
+			      ns' = filter (/= name) ns
+
+upp_export []    = uppNil
+upp_export names = uppBesides [uppChar '(', 
+			       uppIntersperse uppSP (map (upp_occname . getOccName) names), 
+			       uppChar ')']
+
+upp_fixity (occ, (Fixity prec dir, prov)) = uppBesides [upp_dir dir, uppSP, 
+						        uppInt prec, uppSP, 
+					       	        upp_occname occ, uppSemi]
+upp_dir InfixR = uppPStr SLIT("infixr")
+upp_dir InfixL = uppPStr SLIT("infixl")
+upp_dir InfixN = uppPStr SLIT("infix")
 
-    ppr_theta tv []   = ppNil
-    ppr_theta tv [sc] = ppBeside (ppr_assert tv sc) (ppStr " =>")
-    ppr_theta tv super_classes
-      = ppBesides [ppLparen,
-		   ppIntersperse pp'SP{-'-} (map (ppr_assert tv) super_classes),
-		   ppStr ") =>"]
+ppr_unqual_name :: NamedThing a => a -> Unpretty		-- Just its occurrence name
+ppr_unqual_name name = upp_occname (getOccName name)
 
-    ppr_assert tv (Class _ n _ _ _ _ _ _ _ _) = ppCat [ppr_name n, ppr_tyvar tv]
+ppr_name :: NamedThing a => a -> Unpretty		-- Its full name
+ppr_name   n = uppPStr (nameString (getName n))
 
-    ppr_op (ClassOp o _ ty) = pp_sig (Unqual o) ty
+upp_occname :: OccName -> Unpretty
+upp_occname occ = uppPStr (occNameString occ)
+
+upp_module :: Module -> Unpretty
+upp_module mod = uppPStr mod
+
+uppSemid   x = uppBeside (prettyToUn (ppr PprInterface x)) uppSemi -- micro util
+
+ppr_ty	  ty = prettyToUn (pprType PprInterface ty)
+ppr_tyvar tv = prettyToUn (ppr PprInterface tv)
+ppr_tyvar_bndr tv = prettyToUn (pprTyVarBndr PprInterface tv)
+
+ppr_decl decl = prettyToUn (ppr PprInterface decl) `uppBeside` uppSemi
+
+renumber_ty ty = initNmbr (nmbrType ty)
 \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}
-ppr_val v ty -- renumber the type first!
-  = --pprTrace "ppr_val:" (ppr PprDebug v) $
-    pp_sig v (initNmbr (nmbrType ty))
+lt_avail :: AvailInfo -> AvailInfo -> Bool
+
+a1 `lt_avail` a2 = availName a1 `lt_name` availName a2
+
+lt_name :: Name -> Name -> Bool
+n1 `lt_name` n2 = modAndOcc n1 < modAndOcc n2
+
+lt_lexical :: NamedThing a => a -> a -> Bool
+lt_lexical a1 a2 = getName a1 `lt_name` getName a2
 
-pp_sig op ty
-  = ppBesides [ppr_name op, ppPStr SLIT(" :: "), ppr_ty ty, ppSemi]
+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}
-ppr_tycon tycon
-  = --pprTrace "ppr_tycon:" (ppr PprDebug tycon) $
-    ppr_tc (initNmbr (nmbrTyCon tycon))
-
-------------------------
-ppr_tc (PrimTyCon _ n _)
-  = ppCat [ ppStr "{- data", ppr_name n, ppStr " *built-in* -}" ]
-
-ppr_tc FunTyCon
-  = ppCat [ ppStr "{- data", ppr_name FunTyCon, ppStr " *built-in* -}" ]
-
-ppr_tc (TupleTyCon _ n _)
-  = ppCat [ ppStr "{- ", ppr_name n, ppStr "-}" ]
-
-ppr_tc (SynTyCon _ n _ _ tvs expand)
-  = let
-	pp_tyvars   = map ppr_tyvar tvs
-    in
-    ppBesides [ppPStr SLIT("type "), ppr_name n, ppSP, ppIntersperse ppSP pp_tyvars,
-	   ppPStr SLIT(" = "), ppr_ty expand, ppSemi]
-
-ppr_tc this_tycon@(DataTyCon u n k tvs ctxt cons derivings data_or_new)
-  = ppHang (ppCat [pp_data_or_new,
-		   ppr_context ctxt,
-		   ppr_name n,
-		   ppIntersperse ppSP (map ppr_tyvar tvs)])
-	   2
-	   (ppBeside pp_unabstract_condecls ppSemi)
-	   -- NB: we do not print deriving info in interfaces
-  where
-    pp_data_or_new = case data_or_new of
-		      DataType -> ppPStr SLIT("data")
-		      NewType  -> ppPStr SLIT("newtype")
-
-    ppr_context []      = ppNil
-    ppr_context [(c,t)] = ppCat [ppr_name c, ppr_ty t, ppStr "=>"]
-    ppr_context cs
-      = ppBesides[ppLparen,
-		  ppInterleave ppComma [ppCat [ppr_name c, ppr_ty t] | (c,t) <- cs],
-		  ppRparen, ppStr " =>"]
-
-    yes_we_print_condecls
-      = case (getExportFlag n) of
-	  ExportAbs -> False
-	  other	    -> True
-
-    pp_unabstract_condecls
-      = if yes_we_print_condecls
-	then ppCat [ppEquals, pp_condecls]
-	else ppNil
-
-    pp_condecls
-      = let
-	    (c:cs) = cons
-	in
-	ppSep ((ppr_con c) : (map ppr_next_con cs))
-
-    ppr_next_con con = ppCat [ppChar '|', ppr_con con]
-
-    ppr_con con
-      = let
-	    (_, _, con_arg_tys, _) = dataConSig con
-	    labels       = dataConFieldLabels con -- none if not a record
-	    strict_marks = dataConStrictMarks con
-	in
-	ppCat [ppr_unq_name con, ppr_fields labels strict_marks con_arg_tys]
-
-    ppr_fields labels strict_marks con_arg_tys
-      = if null labels then -- not a record thingy
-	    ppIntersperse ppSP (zipWithEqual  ppr_bang_ty strict_marks con_arg_tys)
-	else
-	    ppCat [ ppChar '{',
-	    ppInterleave ppComma (zipWith3Equal ppr_field labels strict_marks con_arg_tys),
-	    ppChar '}' ]
-
-    ppr_bang_ty b t
-      = ppBeside (case b of { MarkedStrict -> ppChar '!'; _ -> ppNil })
-		 (pprParendType PprInterface t)
-
-    ppr_field l b t
-      = ppBesides [ppr_unq_name l, ppPStr SLIT(" :: "),
-		   case b of { MarkedStrict -> ppChar '!'; _ -> ppNil },
-		   ppr_ty t]
+hPutCol :: Handle 
+	-> (a -> Unpretty)
+	-> [a]
+	-> IO ()
+hPutCol hdl fmt xs = hPutStr hdl (uppShow 0 (uppAboves (map fmt xs))) >>
+		     hPutStr hdl "\n"
 \end{code}