From f5262d4457cabda7112af850d4659366a7ce34a1 Mon Sep 17 00:00:00 2001 From: panne Date: Thu, 13 Apr 2000 20:41:32 +0000 Subject: [PATCH] [project @ 2000-04-13 20:41:30 by panne] GHC has instance amnesia again, so a bunch of funny `import Ppr{Core,Type} ()? had to be added. Sorry, but I need a bootstrapping GHC. --- ghc/compiler/codeGen/CgCase.lhs | 3 ++- ghc/compiler/codeGen/CgExpr.lhs | 3 ++- ghc/compiler/coreSyn/CoreLint.lhs | 1 + ghc/compiler/deSugar/DsCCall.lhs | 1 + ghc/compiler/deSugar/DsExpr.lhs | 1 + ghc/compiler/deSugar/DsForeign.lhs | 1 + ghc/compiler/hsSyn/HsCore.lhs | 1 + ghc/compiler/simplCore/SimplUtils.lhs | 2 ++ ghc/compiler/specialise/Specialise.lhs | 1 + ghc/compiler/stgSyn/CoreToStg.lhs | 1 + ghc/compiler/stgSyn/StgLint.lhs | 1 + ghc/compiler/stgSyn/StgSyn.lhs | 1 + ghc/compiler/typecheck/TcDeriv.lhs | 1 + ghc/compiler/typecheck/TcForeign.lhs | 2 +- ghc/compiler/typecheck/TcMonad.lhs | 1 + ghc/compiler/typecheck/TcPat.lhs | 1 + ghc/compiler/usageSP/UsageSPInf.lhs | 1 + ghc/compiler/usageSP/UsageSPLint.lhs | 1 + ghc/compiler/usageSP/UsageSPUtils.lhs | 1 + 19 files changed, 22 insertions(+), 3 deletions(-) diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs index 0bc6508..b9c3149 100644 --- a/ghc/compiler/codeGen/CgCase.lhs +++ b/ghc/compiler/codeGen/CgCase.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgCase.lhs,v 1.40 2000/03/27 16:22:09 simonpj Exp $ +% $Id: CgCase.lhs,v 1.41 2000/04/13 20:41:30 panne Exp $ % %******************************************************** %* * @@ -62,6 +62,7 @@ import TyCon ( TyCon, isEnumerationTyCon, isUnboxedTupleTyCon, tyConDataCons, tyConFamilySize ) import Type ( Type, typePrimRep, splitAlgTyConApp, splitTyConApp_maybe, repType ) +import PprType ( {- instance Outputable Type -} ) import Unique ( Unique, Uniquable(..), mkPseudoUnique1 ) import Maybes ( maybeToBool ) import Util diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs index d30731f..9a9b931 100644 --- a/ghc/compiler/codeGen/CgExpr.lhs +++ b/ghc/compiler/codeGen/CgExpr.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgExpr.lhs,v 1.33 2000/03/27 16:22:09 simonpj Exp $ +% $Id: CgExpr.lhs,v 1.34 2000/04/13 20:41:30 panne Exp $ % %******************************************************** %* * @@ -48,6 +48,7 @@ import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep ) import TyCon ( maybeTyConSingleCon, isUnboxedTupleTyCon, isEnumerationTyCon ) import Type ( Type, typePrimRep, splitTyConApp_maybe, repType ) +import PprType ( {- instance Outputable Type -} ) import Maybes ( assocMaybe, maybeToBool ) import Unique ( mkBuiltinUnique ) import BasicTypes ( TopLevelFlag(..), RecFlag(..) ) diff --git a/ghc/compiler/coreSyn/CoreLint.lhs b/ghc/compiler/coreSyn/CoreLint.lhs index b1602d3..3dc9893 100644 --- a/ghc/compiler/coreSyn/CoreLint.lhs +++ b/ghc/compiler/coreSyn/CoreLint.lhs @@ -39,6 +39,7 @@ import Type ( Type, Kind, tyVarsOfType, isUnboxedTupleType, hasMoreBoxityInfo ) +import PprType ( {- instance Outputable Type -} ) import TyCon ( TyCon, isPrimTyCon, tyConDataCons ) import BasicTypes ( RecFlag(..), isNonRec ) import Outputable diff --git a/ghc/compiler/deSugar/DsCCall.lhs b/ghc/compiler/deSugar/DsCCall.lhs index 052a9a2..11ca5a0 100644 --- a/ghc/compiler/deSugar/DsCCall.lhs +++ b/ghc/compiler/deSugar/DsCCall.lhs @@ -31,6 +31,7 @@ import Type ( isUnLiftedType, splitAlgTyConApp_maybe, mkFunTys, isNewType, repType, isUnLiftedType, mkFunTy, Type ) +import PprType ( {- instance Outputable Type -} ) import TysPrim ( byteArrayPrimTy, realWorldStatePrimTy, byteArrayPrimTyCon, mutableByteArrayPrimTyCon, intPrimTy ) diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs index 8ab7d4d..e1023c2 100644 --- a/ghc/compiler/deSugar/DsExpr.lhs +++ b/ghc/compiler/deSugar/DsExpr.lhs @@ -18,6 +18,7 @@ import TcHsSyn ( TypecheckedHsExpr, TypecheckedHsBinds, TypecheckedStmt ) import CoreSyn +import PprCore ( {- instance Outputable Expr -} ) import CoreUtils ( exprType, mkIfThenElse, bindNonRec ) import DsMonad diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs index f946acb..b3ca8db 100644 --- a/ghc/compiler/deSugar/DsForeign.lhs +++ b/ghc/compiler/deSugar/DsForeign.lhs @@ -36,6 +36,7 @@ import Type ( unUsgTy, Type, mkFunTys, mkForAllTys, mkTyConApp, mkTyVarTy, mkFunTy, splitAppTy, applyTy, funResultTy ) +import PprType ( {- instance Outputable Type -} ) import PrimOp ( PrimOp(..), CCall(..), CCallTarget(..) ) import Var ( TyVar ) import TysPrim ( realWorldStatePrimTy, addrPrimTy ) diff --git a/ghc/compiler/hsSyn/HsCore.lhs b/ghc/compiler/hsSyn/HsCore.lhs index 1837027..d7f1317 100644 --- a/ghc/compiler/hsSyn/HsCore.lhs +++ b/ghc/compiler/hsSyn/HsCore.lhs @@ -30,6 +30,7 @@ import Demand ( Demand ) import Literal ( Literal ) import PrimOp ( CCall, pprCCallOp ) import Type ( Kind ) +import PprType ( {- instance Outputable Type -} ) import CostCentre import SrcLoc ( SrcLoc ) import Outputable diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs index f84278e..fd5f21e 100644 --- a/ghc/compiler/simplCore/SimplUtils.lhs +++ b/ghc/compiler/simplCore/SimplUtils.lhs @@ -21,6 +21,7 @@ module SimplUtils ( import BinderInfo import CmdLineOpts ( opt_SimplDoLambdaEtaExpansion, opt_SimplCaseMerge ) import CoreSyn +import PprCore ( {- instance Outputable Expr -} ) import CoreUnfold ( isValueUnfolding ) import CoreFVs ( exprFreeVars ) import CoreUtils ( exprIsTrivial, cheapEqExpr, exprType, exprIsCheap, exprEtaExpandArity, bindNonRec ) @@ -36,6 +37,7 @@ import SimplMonad import Type ( Type, tyVarsOfType, tyVarsOfTypes, mkForAllTys, seqType, repType, splitTyConApp_maybe, splitAlgTyConApp_maybe, mkTyVarTys, applyTys, splitFunTys, mkFunTys ) +import PprType ( {- instance Outputable Type -} ) import DataCon ( dataConRepArity ) import TysPrim ( statePrimTyCon ) import Var ( setVarUnique ) diff --git a/ghc/compiler/specialise/Specialise.lhs b/ghc/compiler/specialise/Specialise.lhs index 3154df7..24a8b61 100644 --- a/ghc/compiler/specialise/Specialise.lhs +++ b/ghc/compiler/specialise/Specialise.lhs @@ -21,6 +21,7 @@ import Type ( Type, mkTyVarTy, splitSigmaTy, splitFunTysN, tyVarsOfType, tyVarsOfTypes, tyVarsOfTheta, applyTys, mkForAllTys, boxedTypeKind ) +import PprType ( {- instance Outputable Type -} ) import Subst ( Subst, mkSubst, substTy, emptySubst, substBndrs, extendSubstList, substId, substAndCloneId, substAndCloneIds, lookupIdSubst ) diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs index 481c6f5..c62f6ef 100644 --- a/ghc/compiler/stgSyn/CoreToStg.lhs +++ b/ghc/compiler/stgSyn/CoreToStg.lhs @@ -17,6 +17,7 @@ module CoreToStg ( topCoreBindsToStg ) where import CoreSyn -- input import StgSyn -- output +import PprCore ( {- instance Outputable Bind/Expr -} ) import CoreUtils ( exprType ) import SimplUtils ( findDefault ) import CostCentre ( noCCS ) diff --git a/ghc/compiler/stgSyn/StgLint.lhs b/ghc/compiler/stgSyn/StgLint.lhs index c0300a5..67b4c13 100644 --- a/ghc/compiler/stgSyn/StgLint.lhs +++ b/ghc/compiler/stgSyn/StgLint.lhs @@ -22,6 +22,7 @@ import ErrUtils ( ErrMsg, Message, addErrLocHdrLine, pprBagOfErrors, dontAddErr import Type ( mkFunTys, splitFunTys, splitAlgTyConApp_maybe, isUnLiftedType, isTyVarTy, splitForAllTys, Type ) +import PprType ( {- instance Outputable Type -} ) import TyCon ( TyCon, isDataTyCon ) import Util ( zipEqual ) import Outputable diff --git a/ghc/compiler/stgSyn/StgSyn.lhs b/ghc/compiler/stgSyn/StgSyn.lhs index aacde30..0b429a0 100644 --- a/ghc/compiler/stgSyn/StgSyn.lhs +++ b/ghc/compiler/stgSyn/StgSyn.lhs @@ -53,6 +53,7 @@ import PrimOp ( PrimOp ) import PrimRep ( PrimRep(..) ) import Outputable import Type ( Type ) +import PprType ( {- instance Outputable Type -} ) import UniqSet ( isEmptyUniqSet, uniqSetToList, UniqSet ) \end{code} diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs index 156a180..efa3e3d 100644 --- a/ghc/compiler/typecheck/TcDeriv.lhs +++ b/ghc/compiler/typecheck/TcDeriv.lhs @@ -51,6 +51,7 @@ import Type ( TauType, mkTyVarTys, mkTyConApp, mkSigmaTy, mkDictTy, isUnboxedType, splitAlgTyConApp, classesToPreds ) +import PprType ( {- instance Outputable Type -} ) import TysWiredIn ( voidTy ) import Var ( TyVar ) import Unique -- Keys stuff diff --git a/ghc/compiler/typecheck/TcForeign.lhs b/ghc/compiler/typecheck/TcForeign.lhs index 1a7b6e9..77e9e42 100644 --- a/ghc/compiler/typecheck/TcForeign.lhs +++ b/ghc/compiler/typecheck/TcForeign.lhs @@ -45,7 +45,7 @@ import Type ( splitFunTys , isForAllTy , mkForAllTys ) - +import PprType ( {- instance Outputable Type -} ) import TysWiredIn ( isFFIArgumentTy, isFFIResultTy, isFFIExternalTy, isAddrTy ) diff --git a/ghc/compiler/typecheck/TcMonad.lhs b/ghc/compiler/typecheck/TcMonad.lhs index 1b442af..a4d8ef1 100644 --- a/ghc/compiler/typecheck/TcMonad.lhs +++ b/ghc/compiler/typecheck/TcMonad.lhs @@ -49,6 +49,7 @@ import HsSyn ( HsLit ) import RnHsSyn ( RenamedPat, RenamedArithSeqInfo, RenamedHsExpr ) import Type ( Type, Kind, PredType, ThetaType, RhoType, TauType, ) +import PprType ( {- instance Outputable Type -} ) import ErrUtils ( addShortErrLocLine, addShortWarnLocLine, pprBagOfErrors, ErrMsg, Message, WarnMsg ) import CmdLineOpts ( opt_PprStyle_Debug ) diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs index 88914ac..b036e39 100644 --- a/ghc/compiler/typecheck/TcPat.lhs +++ b/ghc/compiler/typecheck/TcPat.lhs @@ -37,6 +37,7 @@ import DataCon ( DataCon, dataConSig, dataConFieldLabels, ) import Id ( Id, idType, isDataConWrapId_maybe ) import Type ( Type, isTauTy, mkTyConApp, mkClassPred, boxedTypeKind ) +import PprType ( {- instance Outputable Type -} ) import Subst ( substTy, substClasses ) import TysPrim ( charPrimTy, intPrimTy, floatPrimTy, doublePrimTy, addrPrimTy diff --git a/ghc/compiler/usageSP/UsageSPInf.lhs b/ghc/compiler/usageSP/UsageSPInf.lhs index 60faf60..ee9be6e 100644 --- a/ghc/compiler/usageSP/UsageSPInf.lhs +++ b/ghc/compiler/usageSP/UsageSPInf.lhs @@ -25,6 +25,7 @@ import Type ( UsageAnn(..), mkUsgTy, splitUsgTy, isUsgTy, isNotUsgTy, unUsgTy, tyUsg, splitUsForAllTys, substUsTy, mkFunTy, mkForAllTy ) +import PprType ( {- instance Outputable Type -} ) import TyCon ( tyConArgVrcs_maybe, isFunTyCon ) import Literal ( Literal(..), literalType ) import Var ( Var, UVar, varType, setVarType, mkUVar, modifyIdInfo ) diff --git a/ghc/compiler/usageSP/UsageSPLint.lhs b/ghc/compiler/usageSP/UsageSPLint.lhs index 7d6f5e0..1c97ffc 100644 --- a/ghc/compiler/usageSP/UsageSPLint.lhs +++ b/ghc/compiler/usageSP/UsageSPLint.lhs @@ -21,6 +21,7 @@ import UsageSPUtils import CoreSyn import TypeRep ( Type(..), TyNote(..) ) -- friend import Type ( UsageAnn(..), isUsgTy, tyUsg ) +import PprType ( {- instance Outputable Type -} ) import TyCon ( isAlgTyCon, isPrimTyCon, isSynTyCon, isFunTyCon ) import Var ( Var, varType ) import Id ( idLBVarInfo ) diff --git a/ghc/compiler/usageSP/UsageSPUtils.lhs b/ghc/compiler/usageSP/UsageSPUtils.lhs index c45f83e..1628413 100644 --- a/ghc/compiler/usageSP/UsageSPUtils.lhs +++ b/ghc/compiler/usageSP/UsageSPUtils.lhs @@ -31,6 +31,7 @@ import Id ( mayHaveNoBinding, isExportedId ) import Name ( isLocallyDefined ) import TypeRep ( Type(..), TyNote(..) ) -- friend import Type ( UsageAnn(..), isUsgTy, splitFunTys ) +import PprType ( {- instance Outputable Type -} ) import Subst ( substTy, mkTyVarSubst ) import TyCon ( isAlgTyCon, isPrimTyCon, isSynTyCon, isFunTyCon ) import VarEnv -- 1.7.10.4