diff --git a/ghc/compiler/basicTypes/IdLoop.lhi b/ghc/compiler/basicTypes/IdLoop.lhi
index 4d2fdf5439165c05c22dbd41bfe199956a5ee10d..e22065b459d968858ab26161f089b46e138dcb73 100644
--- a/ghc/compiler/basicTypes/IdLoop.lhi
+++ b/ghc/compiler/basicTypes/IdLoop.lhi
@@ -13,7 +13,7 @@ import CoreUnfold 	( Unfolding(..), UnfoldingGuidance(..), mkUnfolding,
 			  SimpleUnfolding(..), FormSummary(..), noUnfolding  )
 import CoreUtils	( unTagBinders )
 import Id		( externallyVisibleId, isDataCon, isWorkerId, isWrapperId,
-			  unfoldingUnfriendlyId, getIdInfo, nmbrId,
+			  unfoldingUnfriendlyId, getIdInfo, nmbrId, pprId,
 			  nullIdEnv, lookupIdEnv, IdEnv(..),
 			  Id(..), GenId
 			)
@@ -29,9 +29,8 @@ import SpecEnv		( SpecEnv, nullSpecEnv, isNullSpecEnv )
 import Literal		( Literal )
 import MagicUFs		( mkMagicUnfoldingFun, MagicUnfoldingFun )
 import OccurAnal	( occurAnalyseGlobalExpr )
-import Outputable	( Outputable(..) )
+import Outputable	( Outputable(..), PprStyle )
 import PprEnv		( NmbrEnv )
-import PprStyle		( PprStyle )
 import PprType		( pprParendGenType )
 import PragmaInfo	( PragmaInfo )
 import Pretty		( Doc )
@@ -56,6 +55,7 @@ externallyVisibleId	:: Id	    -> Bool
 isDataCon		:: GenId ty -> Bool
 isWorkerId		:: GenId ty -> Bool
 nmbrId			:: Id -> NmbrEnv -> (NmbrEnv, Id)
+pprId			:: Outputable ty => PprStyle -> GenId ty -> Doc
 mkMagicUnfoldingFun	:: Unique -> MagicUnfoldingFun
 
 
diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs
index cf9909e6cac6216a8a6ad30b274e735b7f501e93..738dcf108c9c192607d85aaa0147d0511b6a5004 100644
--- a/ghc/compiler/basicTypes/Literal.lhs
+++ b/ghc/compiler/basicTypes/Literal.lhs
@@ -28,11 +28,10 @@ import TysPrim		( getPrimRepInfo,
 import CStrings		( stringToC, charToC, charToEasyHaskell )
 import TysWiredIn	( stringTy )
 import Pretty		-- pretty-printing stuff
-import PprStyle		( PprStyle(..), codeStyle, ifaceStyle )
-import Util		--( thenCmp, panic, pprPanic )
+import Outputable	( PprStyle(..), codeStyle, ifaceStyle, Outputable(..) )
+import Util		( thenCmp, panic, pprPanic, Ord3(..) )
 #if __GLASGOW_HASKELL__ >= 202
 import Type
-import Outputable
 #endif
 \end{code}