From f37e239fb5e81fc493e0ea1af98178bf1f7ceaba Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Sat, 23 Sep 2006 03:52:01 +0000 Subject: [PATCH] Trim imports, and remove some dead code --- compiler/basicTypes/MkId.lhs | 3 +-- compiler/coreSyn/CoreTidy.lhs | 4 ++-- compiler/iface/LoadIface.lhs | 3 +-- compiler/iface/TcIface.lhs | 14 +++++--------- compiler/prelude/PrelRules.lhs | 2 +- compiler/rename/RnExpr.lhs | 5 ++--- compiler/simplCore/Simplify.lhs | 12 ++++-------- compiler/typecheck/TcForeign.lhs | 3 +-- compiler/types/TyCon.lhs | 6 +----- compiler/types/Type.lhs | 4 ++-- compiler/types/TypeRep.lhs-boot | 4 ---- 11 files changed, 20 insertions(+), 40 deletions(-) diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index 3e54813..41460e1 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -47,7 +47,7 @@ import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy, import TysWiredIn ( charTy, mkListTy ) import PrelRules ( primOpRules ) import Type ( TyThing(..), mkForAllTy, tyVarsOfTypes, - newTyConInstRhs, mkTopTvSubst, substTyVar, substTy, + newTyConInstRhs, mkTopTvSubst, substTyVar, substTys, zipTopTvSubst ) import TcGadt ( gadtRefine, refineType, emptyRefinement ) import HsBinds ( ExprCoFn(..), isIdCoercion ) @@ -97,7 +97,6 @@ import NewDemand ( mkStrictSig, DmdResult(..), import DmdAnal ( dmdAnalTopRhs ) import CoreSyn import Unique ( mkBuiltinUnique, mkPrimOpIdUnique ) -import Maybe ( fromJust ) import Maybes import PrelNames import Util ( dropList, isSingleton ) diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs index 35948fc..bacf64f 100644 --- a/compiler/coreSyn/CoreTidy.lhs +++ b/compiler/coreSyn/CoreTidy.lhs @@ -15,8 +15,8 @@ import Id ( Id, mkUserLocal, idInfo, setIdInfo, idUnique, idType ) import IdInfo ( setArityInfo, vanillaIdInfo, newStrictnessInfo, setAllStrictnessInfo, newDemandInfo, setNewDemandInfo ) -import Type ( tidyType, tidyTyVarBndr, substTy ) -import Var ( Var, TyVar, varName ) +import Type ( tidyType, tidyTyVarBndr ) +import Var ( Var, varName ) import VarEnv import UniqFM ( lookupUFM ) import Name ( Name, getOccName ) diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index a97f8ed..d4cd503 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -37,7 +37,6 @@ import BasicTypes ( Version, initialVersion, Fixity(..), FixityDirection(..), isMarkedStrict ) import TcRnMonad import Type ( TyThing(..) ) -import Class ( classATs ) import PrelNames ( gHC_PRIM ) import PrelInfo ( ghcPrimExports ) @@ -52,7 +51,7 @@ import Module import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc, mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc, - mkNewTyCoOcc, mkInstTyTcOcc, mkInstTyCoOcc ) + mkNewTyCoOcc, mkInstTyCoOcc ) import SrcLoc ( importedSrcLoc ) import Maybes ( MaybeErr(..) ) import ErrUtils ( Message ) diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index cb37580..20aaa9f 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -27,18 +27,15 @@ import TcRnMonad import Type ( liftedTypeKind, splitTyConApp, mkTyConApp, liftedTypeKindTyCon, unliftedTypeKindTyCon, openTypeKindTyCon, argTypeKindTyCon, - ubxTupleKindTyCon, - mkTyVarTys, ThetaType ) + ubxTupleKindTyCon, ThetaType ) import TypeRep ( Type(..), PredType(..) ) -import TyCon ( TyCon, tyConName, SynTyConRhs(..), - AlgTyConParent(..), setTyConArgPoss ) +import TyCon ( TyCon, tyConName, SynTyConRhs(..), setTyConArgPoss ) import HscTypes ( ExternalPackageState(..), TyThing(..), tyThingClass, tyThingTyCon, ModIface(..), ModDetails(..), HomeModInfo(..), emptyModDetails, lookupTypeEnv, lookupType, typeEnvIds, mkDetailsFamInstCache ) import InstEnv ( Instance(..), mkImportedInstance ) -import FamInstEnv ( extractFamInsts ) import CoreSyn import CoreUtils ( exprType, dataConRepFSInstPat ) import CoreUnfold @@ -52,9 +49,9 @@ import IdInfo ( IdInfo, CafInfo(..), WorkerInfo(..), vanillaIdInfo, newStrictnessInfo ) import Class ( Class ) import TyCon ( tyConDataCons, isTupleTyCon, mkForeignTyCon ) -import DataCon ( DataCon, dataConWorkId, dataConExTyVars, dataConInstArgTys ) +import DataCon ( DataCon, dataConWorkId ) import TysWiredIn ( tupleCon, tupleTyCon, listTyCon, intTyCon, boolTyCon, charTyCon, parrTyCon ) -import Var ( TyVar, mkTyVar, tyVarKind ) +import Var ( TyVar, mkTyVar ) import Name ( Name, nameModule, nameIsLocalOrFrom, isWiredInName, nameOccName, wiredInNameTyThing_maybe ) import NameEnv @@ -68,12 +65,11 @@ import Outputable import ErrUtils ( Message ) import Maybes ( MaybeErr(..) ) import SrcLoc ( noSrcLoc ) -import Util ( zipWithEqual, equalLength, splitAtList ) +import Util ( zipWithEqual, equalLength ) import DynFlags ( DynFlag(..), isOneShot ) import List ( elemIndex) import Maybe ( catMaybes ) -import Monad ( liftM ) \end{code} This module takes diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index 8bdaeb3..f7a3198 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -20,7 +20,7 @@ module PrelRules ( primOpRules, builtinRules ) where #include "HsVersions.h" import CoreSyn -import Id ( mkWildId, isPrimOpId_maybe, idUnfolding ) +import Id ( mkWildId, idUnfolding ) import Literal ( Literal(..), mkMachInt, mkMachWord , literalType , word2IntLit, int2WordLit diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index be0970c..8ff7962 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -23,7 +23,6 @@ import HsSyn import RnHsSyn import TcRnMonad import RnEnv -import OccName ( plusOccEnv ) import RnNames ( getLocalDeclBinders, extendRdrEnvRn ) import RnTypes ( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit, mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec, @@ -43,7 +42,7 @@ import Name ( isTyVarName ) #endif import Name ( Name, nameOccName, nameIsLocalOrFrom ) import NameSet -import RdrName ( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals ) +import RdrName ( RdrName, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals ) import LoadIface ( loadInterfaceForName ) import UniqFM ( isNullUFM ) import UniqSet ( emptyUniqSet ) @@ -968,10 +967,10 @@ mkBreakpointExpr' breakpointFunc scope mkScopeArg args = unLoc $ mkExpr undef (map HsVar args) msg = srcSpanLit sloc return (expr, emptyFVs) -#endif srcSpanLit :: SrcSpan -> HsExpr Name srcSpanLit span = HsLit (HsString (mkFastString (showSDoc (ppr span)))) +#endif srcSpanPrimLit :: SrcSpan -> HsExpr Name srcSpanPrimLit span = HsLit (HsStringPrim (mkFastString (showSDoc (ppr span)))) diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index f477038..dffdd75 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -26,8 +26,6 @@ import Id ( Id, idType, idInfo, idArity, isDataConWorkId, idNewDemandInfo, setIdInfo, setIdOccInfo, zapLamIdInfo, setOneShotLambda ) -import MkId ( eRROR_ID ) -import Literal ( mkStringLit ) import IdInfo ( OccInfo(..), isLoopBreaker, setArityInfo, zapDemandInfo, setUnfoldingInfo, @@ -35,7 +33,7 @@ import IdInfo ( OccInfo(..), isLoopBreaker, ) import NewDemand ( isStrictDmd ) import TcGadt ( dataConCanMatch ) -import DataCon ( DataCon, dataConTyCon, dataConRepStrictness ) +import DataCon ( dataConTyCon, dataConRepStrictness ) import TyCon ( tyConArity, isAlgTyCon, isNewTyCon, tyConDataCons_maybe ) import CoreSyn import PprCore ( pprParendExpr, pprCoreExpr ) @@ -51,13 +49,11 @@ import Rules ( lookupRule ) import BasicTypes ( isMarkedStrict ) import CostCentre ( currentCCS ) import Type ( TvSubstEnv, isUnLiftedType, seqType, tyConAppArgs, funArgTy, - splitFunTy_maybe, splitFunTy, coreEqType, splitTyConApp_maybe, - isTyVarTy, mkTyVarTys, isFunTy, tcEqType + coreEqType, splitTyConApp_maybe, + isTyVarTy, isFunTy, tcEqType ) import Coercion ( Coercion, coercionKind, - mkTransCoercion, mkLeftCoercion, mkRightCoercion, - mkSymCoercion, splitCoercionKind_maybe, decomposeCo ) -import Var ( tyVarKind, mkTyVar ) + mkTransCoercion, mkSymCoercion, splitCoercionKind_maybe, decomposeCo ) import VarEnv ( elemVarEnv, emptyVarEnv ) import TysPrim ( realWorldStatePrimTy ) import PrelInfo ( realWorldPrimId ) diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index fa91028..6894238 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -34,7 +34,7 @@ import SMRep ( argMachRep, primRepToCgRep, primRepHint ) #endif import OccName ( mkForeignExportOcc ) import Name ( Name, NamedThing(..), mkExternalName ) -import TcType ( Type, tcSplitFunTys, tcSplitTyConApp_maybe, +import TcType ( Type, tcSplitFunTys, tcSplitForAllTys, tcSplitIOType_maybe, isFFIArgumentTy, isFFIImportResultTy, isFFIExportResultTy, isFFILabelTy, @@ -45,7 +45,6 @@ import TcType ( Type, tcSplitFunTys, tcSplitTyConApp_maybe, import ForeignCall ( CExportSpec(..), CCallTarget(..), CLabelString, isCLabelString, isDynamicTarget, withDNTypes, DNKind(..), DNCallSpec(..) ) -import PrelNames ( hasKey, ioTyConKey ) import DynFlags ( DynFlags(..), HscTarget(..) ) import Outputable import SrcLoc ( Located(..), srcSpanStart ) diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index b359660..51bc1f1 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -61,7 +61,7 @@ module TyCon( #include "HsVersions.h" -import {-# SOURCE #-} TypeRep ( Kind, Type, Coercion, PredType ) +import {-# SOURCE #-} TypeRep ( Kind, Type, PredType ) import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon ) import Var ( TyVar, Id ) @@ -194,10 +194,6 @@ data TyCon tyConName :: Name } -type KindCon = TyCon - -type SuperKindCon = TyCon - type FieldLabel = Name data AlgTyConRhs diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index e872d6a..0d7767b 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -117,12 +117,12 @@ import PrelNames( openTypeKindTyConKey, unliftedTypeKindTyConKey, ubxTupleKindTyConKey, argTypeKindTyConKey ) import TyCon ( TyCon, isRecursiveTyCon, isPrimTyCon, isUnboxedTupleTyCon, isUnLiftedTyCon, - isFunTyCon, isNewTyCon, isClosedNewTyCon, isOpenTyCon, + isFunTyCon, isNewTyCon, isClosedNewTyCon, newTyConRep, newTyConRhs, isAlgTyCon, tyConArity, isSuperKindTyCon, tcExpandTyCon_maybe, coreExpandTyCon_maybe, tyConKind, PrimRep(..), tyConPrimRep, tyConUnique, - isCoercionTyCon_maybe, isCoercionTyCon + isCoercionTyCon ) -- others diff --git a/compiler/types/TypeRep.lhs-boot b/compiler/types/TypeRep.lhs-boot index b259005..2acd5a0 100644 --- a/compiler/types/TypeRep.lhs-boot +++ b/compiler/types/TypeRep.lhs-boot @@ -1,14 +1,10 @@ \begin{code} module TypeRep where -import {-# SOURCE #-} TyCon ( TyCon ) - data Type data PredType data TyThing -type Coercion = Type - type Kind = Type type SuperKind = Type -- 1.7.10.4