From 98744cef7b82e7eefbb1c6f1d8b9e28c415939c4 Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 17 Nov 2003 14:23:39 +0000 Subject: [PATCH] [project @ 2003-11-17 14:23:30 by simonmar] GC some dead code. In some places, I left useful-looking but currently unused definitions in place, surrounded by #ifdef UNUSED ... #endif. --- ghc/compiler/Makefile | 1 - ghc/compiler/basicTypes/RdrName.lhs | 30 ++---------------------------- ghc/compiler/basicTypes/Unique.lhs | 17 +++++++---------- ghc/compiler/codeGen/CgClosure.lhs | 6 +++--- ghc/compiler/codeGen/ClosureInfo.lhs | 4 +--- ghc/compiler/compMan/CompManager.lhs | 3 --- ghc/compiler/coreSyn/CoreUtils.lhs | 14 ++++++-------- ghc/compiler/coreSyn/PprExternalCore.lhs | 2 +- ghc/compiler/ghci/Linker.lhs | 2 +- ghc/compiler/iface/IfaceEnv.lhs | 2 +- ghc/compiler/iface/LoadIface.lhs | 2 +- ghc/compiler/main/CmdLineOpts.lhs | 20 -------------------- ghc/compiler/main/DriverMkDepend.hs | 6 ++++-- ghc/compiler/parser/Lexer.x | 2 +- ghc/compiler/prelude/PrimOp.lhs | 13 +------------ ghc/compiler/typecheck/Inst.lhs | 2 -- ghc/compiler/types/Class.lhs | 6 +----- ghc/compiler/types/InstEnv.lhs | 5 +++-- ghc/compiler/utils/FastMutInt.lhs | 15 +-------------- ghc/compiler/utils/PrimPacked.lhs | 19 ++++++++----------- ghc/compiler/utils/StringBuffer.lhs | 4 ---- 21 files changed, 42 insertions(+), 133 deletions(-) diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index c91154f..2f618ba 100644 --- a/ghc/compiler/Makefile +++ b/ghc/compiler/Makefile @@ -216,7 +216,6 @@ ifeq ($(GhcWithIlx),YES) endif @echo "cEnableWin32DLLs = \"$(EnableWin32DLLs)\"" >> $(CONFIG_HS) @echo "cCONTEXT_DIFF = \"$(CONTEXT_DIFF)\"" >> $(CONFIG_HS) - @echo "cHaveLibGmp = \"$(HaveLibGmp)\"" >> $(CONFIG_HS) @echo "cUSER_WAY_NAMES = \"$(USER_WAY_NAMES)\"" >> $(CONFIG_HS) @echo "cUSER_WAY_OPTS = \"$(USER_WAY_OPTS)\"" >> $(CONFIG_HS) @echo "cDEFAULT_TMPDIR = \"$(DEFAULT_TMPDIR)\"" >> $(CONFIG_HS) diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs index df4b4d1..12fbf73 100644 --- a/ghc/compiler/basicTypes/RdrName.lhs +++ b/ghc/compiler/basicTypes/RdrName.lhs @@ -10,11 +10,9 @@ module RdrName ( -- Construction mkRdrUnqual, mkRdrQual, - mkUnqual, mkVarUnqual, mkQual, mkOrig, mkIfaceOrig, + mkUnqual, mkVarUnqual, mkQual, mkOrig, nameRdrName, getRdrName, - qualifyRdrName, unqualifyRdrName, mkDerivedRdrName, - dummyRdrVarName, dummyRdrTcName, -- Destruction rdrNameModule, rdrNameOcc, setRdrNameSpace, @@ -22,7 +20,6 @@ module RdrName ( isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, -- Printing; instance Outputable RdrName - pprUnqualRdrName, -- LocalRdrEnv LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, @@ -35,7 +32,7 @@ module RdrName ( -- GlobalRdrElt, Provenance, ImportSpec GlobalRdrElt(..), Provenance(..), ImportSpec(..), - isLocalGRE, unQualOK, hasQual, + isLocalGRE, unQualOK, pprNameProvenance ) where @@ -141,9 +138,6 @@ mkRdrQual mod occ = Qual mod occ mkOrig :: ModuleName -> OccName -> RdrName mkOrig mod occ = Orig mod occ -mkIfaceOrig :: NameSpace -> EncodedFS -> EncodedFS -> RdrName -mkIfaceOrig ns m n = Orig (mkSysModuleNameFS m) (mkSysOccFS ns n) - --------------- mkDerivedRdrName :: Name -> (OccName -> OccName) -> (RdrName) mkDerivedRdrName parent mk_occ @@ -170,13 +164,6 @@ nameRdrName name = Exact name -- unique is still there for debug printing, particularly -- of Types (which are converted to IfaceTypes before printing) -qualifyRdrName :: ModuleName -> RdrName -> RdrName - -- Sets the module name of a RdrName, even if it has one already -qualifyRdrName mod rn = Qual mod (rdrNameOcc rn) - -unqualifyRdrName :: RdrName -> RdrName -unqualifyRdrName rdr_name = Unqual (rdrNameOcc rdr_name) - nukeExact :: Name -> RdrName nukeExact n | isExternalName n = Orig (nameModuleName n) (nameOccName n) @@ -184,17 +171,6 @@ nukeExact n \end{code} \begin{code} - -- This guy is used by the reader when HsSyn has a slot for - -- an implicit name that's going to be filled in by - -- the renamer. We can't just put "error..." because - -- we sometimes want to print out stuff after reading but - -- before renaming -dummyRdrVarName = Unqual (mkVarOcc FSLIT("V-DUMMY")) -dummyRdrTcName = Unqual (mkOccFS tcName FSLIT("TC-DUMMY")) -\end{code} - - -\begin{code} isRdrDataCon rn = isDataOcc (rdrNameOcc rn) isRdrTyVar rn = isTvOcc (rdrNameOcc rn) isRdrTc rn = isTcOcc (rdrNameOcc rn) @@ -243,8 +219,6 @@ instance OutputableBndr RdrName where | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n | otherwise = ppr n -pprUnqualRdrName rdr_name = ppr (rdrNameOcc rdr_name) - instance Eq RdrName where (Exact n1) == (Exact n2) = n1==n2 -- Convert exact to orig diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs index b73b38c..9f5109f 100644 --- a/ghc/compiler/basicTypes/Unique.lhs +++ b/ghc/compiler/basicTypes/Unique.lhs @@ -18,18 +18,16 @@ Haskell). module Unique ( Unique, Uniquable(..), hasKey, - pprUnique, pprUnique10, + pprUnique, mkUnique, -- Used in UniqSupply mkUniqueGrimily, -- Used in UniqSupply only! getKey, getKey#, -- Used in Var, UniqFM, Name only! - unpkUnique, incrUnique, -- Used for renumbering deriveUnique, -- Ditto newTagUnique, -- Used in CgCase initTyVarUnique, - initTidyUniques, isTupleKey, @@ -42,8 +40,8 @@ module Unique ( mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, - mkBuiltinUnique, builtinUniques, - mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3 + mkBuiltinUnique, + mkPseudoUnique3 ) where #include "HsVersions.h" @@ -198,15 +196,17 @@ instance Uniquable Unique where We do sometimes make strings with @Uniques@ in them: \begin{code} -pprUnique, pprUnique10 :: Unique -> SDoc - +pprUnique :: Unique -> SDoc pprUnique uniq = case unpkUnique uniq of (tag, u) -> finish_ppr tag u (iToBase62 u) +#ifdef UNUSED +pprUnique10 :: Unique -> SDoc pprUnique10 uniq -- in base-10, dudes = case unpkUnique uniq of (tag, u) -> finish_ppr tag u (int u) +#endif finish_ppr 't' u pp_u | u < 26 = -- Special case to make v common tyvars, t1, t2, ... @@ -303,9 +303,6 @@ mkPArrDataConUnique a = mkUnique ':' (2*a) initTyVarUnique :: Unique initTyVarUnique = mkUnique 't' 0 -initTidyUniques :: (Unique, Unique) -- Global and local -initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0) - mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3, mkBuiltinUnique :: Int -> Unique diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs index b3b9afc..6e77dc7 100644 --- a/ghc/compiler/codeGen/CgClosure.lhs +++ b/ghc/compiler/codeGen/CgClosure.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgClosure.lhs,v 1.61 2003/10/30 16:01:52 simonpj Exp $ +% $Id: CgClosure.lhs,v 1.62 2003/11/17 14:23:31 simonmar Exp $ % \section[CgClosure]{Code generation for closures} @@ -12,8 +12,8 @@ with {\em closures} on the RHSs of let(rec)s. See also \begin{code} module CgClosure ( cgTopRhsClosure, cgStdRhsClosure, - cgRhsClosure, - closureCodeBody ) where + cgRhsClosure, + ) where #include "HsVersions.h" diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs index 4641b63..2de8802 100644 --- a/ghc/compiler/codeGen/ClosureInfo.lhs +++ b/ghc/compiler/codeGen/ClosureInfo.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: ClosureInfo.lhs,v 1.60 2003/10/30 16:01:52 simonpj Exp $ +% $Id: ClosureInfo.lhs,v 1.61 2003/11/17 14:23:31 simonmar Exp $ % \section[ClosureInfo]{Data structures which describe closures} @@ -17,7 +17,6 @@ module ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo, mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, - UpdateFlag, closureSize, closureNonHdrSize, closureGoodStuffSize, closurePtrsSize, @@ -40,7 +39,6 @@ module ClosureInfo ( closureLFInfo, closureSMRep, closureUpdReqd, closureSingleEntry, closureReEntrant, closureSemiTag, closureFunInfo, isStandardFormThunk, - GenStgArg, isToplevClosure, closureTypeDescr, -- profiling diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index bf2d7d5..221ba31 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -44,13 +44,10 @@ module CompManager ( -- -> IO (CmState, Maybe HValue) cmGetModInfo, -- :: CmState -> (ModuleGraph, HomePackageTable) - findModuleLinkable_maybe, -- Exported to InteractiveUI cmSetDFlags, cmGetBindings, -- :: CmState -> [TyThing] cmGetPrintUnqual, -- :: CmState -> PrintUnqualified - - sandboxIO -- Should be somewhere else #endif ) where diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs index 5a82fdd..67d1610 100644 --- a/ghc/compiler/coreSyn/CoreUtils.lhs +++ b/ghc/compiler/coreSyn/CoreUtils.lhs @@ -6,16 +6,16 @@ \begin{code} module CoreUtils ( -- Construction - mkNote, mkInlineMe, mkSCC, mkCoerce, mkCoerce2, + mkInlineMe, mkSCC, mkCoerce, mkCoerce2, bindNonRec, needsCaseBinding, mkIfThenElse, mkAltExpr, mkPiType, mkPiTypes, -- Taking expressions apart - findDefault, findAlt, hasDefault, + findDefault, findAlt, -- Properties of expressions - exprType, coreAltsType, - exprIsBottom, exprIsDupable, exprIsTrivial, exprIsCheap, + exprType, + exprIsDupable, exprIsTrivial, exprIsCheap, exprIsValue,exprOkForSpeculation, exprIsBig, exprIsConApp_maybe, rhsIsStatic, @@ -154,11 +154,13 @@ applyTypeToArgs e op_ty (other_arg : args) mkNote removes redundant coercions, and SCCs where possible \begin{code} +#ifdef UNUSED mkNote :: Note -> CoreExpr -> CoreExpr mkNote (Coerce to_ty from_ty) expr = mkCoerce2 to_ty from_ty expr mkNote (SCC cc) expr = mkSCC cc expr mkNote InlineMe expr = mkInlineMe expr mkNote note expr = Note note expr +#endif -- Slide InlineCall in around the function -- No longer necessary I think (SLPJ Apr 99) @@ -276,10 +278,6 @@ The default alternative must be first, if it exists at all. This makes it easy to find, though it makes matching marginally harder. \begin{code} -hasDefault :: [CoreAlt] -> Bool -hasDefault ((DEFAULT,_,_) : alts) = True -hasDefault _ = False - findDefault :: [CoreAlt] -> ([CoreAlt], Maybe CoreExpr) findDefault ((DEFAULT,args,rhs) : alts) = ASSERT( null args ) (alts, Just rhs) findDefault alts = (alts, Nothing) diff --git a/ghc/compiler/coreSyn/PprExternalCore.lhs b/ghc/compiler/coreSyn/PprExternalCore.lhs index 357780d..871f43c 100644 --- a/ghc/compiler/coreSyn/PprExternalCore.lhs +++ b/ghc/compiler/coreSyn/PprExternalCore.lhs @@ -3,7 +3,7 @@ % \begin{code} -module PprExternalCore where +module PprExternalCore () where import Pretty import ExternalCore diff --git a/ghc/compiler/ghci/Linker.lhs b/ghc/compiler/ghci/Linker.lhs index 2ceb589..f8e6175 100644 --- a/ghc/compiler/ghci/Linker.lhs +++ b/ghc/compiler/ghci/Linker.lhs @@ -15,7 +15,7 @@ necessary. {-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-} -module Linker ( HValue, initDynLinker, showLinkerState, +module Linker ( HValue, showLinkerState, linkExpr, unload, extendLinkEnv, linkPackages, ) where diff --git a/ghc/compiler/iface/IfaceEnv.lhs b/ghc/compiler/iface/IfaceEnv.lhs index d0c5d8f..8cfaf66 100644 --- a/ghc/compiler/iface/IfaceEnv.lhs +++ b/ghc/compiler/iface/IfaceEnv.lhs @@ -11,7 +11,7 @@ module IfaceEnv ( tcIfaceTyVar, tcIfaceDataCon, tcIfaceLclId, -- Name-cache stuff - allocateGlobalBinder, extendOrigNameCache, initNameCache + allocateGlobalBinder, initNameCache ) where #include "HsVersions.h" diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs index 74f41b0..be77d8f 100644 --- a/ghc/compiler/iface/LoadIface.lhs +++ b/ghc/compiler/iface/LoadIface.lhs @@ -5,7 +5,7 @@ \begin{code} module LoadIface ( - loadHomeInterface, loadInterface, loadSysInterface, + loadHomeInterface, loadInterface, loadSrcInterface, loadOrphanModules, readIface, -- Used when reading the module's old interface predInstGates, ifaceInstGates, ifaceStats, diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 7a4799b..44cce87 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -20,7 +20,6 @@ module CmdLineOpts ( -- Manipulating DynFlags defaultDynFlags, -- DynFlags - defaultHscLang, -- HscLang dopt, -- DynFlag -> DynFlags -> Bool dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags dopt_CoreToDo, -- DynFlags -> [CoreToDo] @@ -42,13 +41,10 @@ module CmdLineOpts ( restoreDynFlags, -- IO DynFlags -- sets of warning opts - standardWarnings, minusWOpts, minusWallOpts, -- Output style options - opt_PprStyle_NoPrags, - opt_PprStyle_RawTypes, opt_PprUserLength, opt_PprStyle_Debug, @@ -56,16 +52,13 @@ module CmdLineOpts ( opt_AutoSccsOnAllToplevs, opt_AutoSccsOnExportedToplevs, opt_AutoSccsOnIndividualCafs, - opt_AutoSccsOnDicts, opt_SccProfilingOn, opt_DoTickyProfiling, -- language opts - opt_AllStrict, opt_DictsStrict, opt_MaxContextReductionDepth, opt_IrrefutableTuples, - opt_NumbersStrict, opt_Parallel, opt_SMP, opt_RuntimeTypes, @@ -73,7 +66,6 @@ module CmdLineOpts ( -- optimisation opts opt_NoMethodSharing, - opt_DoSemiTagging, opt_LiberateCaseThreshold, opt_CprOff, opt_RulesOff, @@ -87,7 +79,6 @@ module CmdLineOpts ( opt_UF_FunAppDiscount, opt_UF_KeenessFactor, opt_UF_UpdateInPlace, - opt_UF_CheapOp, opt_UF_DearOp, -- misc opts @@ -97,9 +88,7 @@ module CmdLineOpts ( opt_GranMacros, opt_HiVersion, opt_HistorySize, - opt_NoHiCheck, opt_OmitBlackHoling, - opt_NoPruneDecls, opt_Static, opt_Unregisterised, opt_EmitExternalCore @@ -750,16 +739,13 @@ unpacked_opts = \begin{code} -- debugging opts -opt_PprStyle_NoPrags = lookUp FSLIT("-dppr-noprags") opt_PprStyle_Debug = lookUp FSLIT("-dppr-debug") -opt_PprStyle_RawTypes = lookUp FSLIT("-dppr-rawtypes") opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name -- profiling opts opt_AutoSccsOnAllToplevs = lookUp FSLIT("-fauto-sccs-on-all-toplevs") opt_AutoSccsOnExportedToplevs = lookUp FSLIT("-fauto-sccs-on-exported-toplevs") opt_AutoSccsOnIndividualCafs = lookUp FSLIT("-fauto-sccs-on-individual-cafs") -opt_AutoSccsOnDicts = lookUp FSLIT("-fauto-sccs-on-dicts") opt_SccProfilingOn = lookUp FSLIT("-fscc-profiling") opt_DoTickyProfiling = lookUp FSLIT("-fticky-ticky") @@ -768,14 +754,12 @@ opt_AllStrict = lookUp FSLIT("-fall-strict") opt_DictsStrict = lookUp FSLIT("-fdicts-strict") opt_IrrefutableTuples = lookUp FSLIT("-firrefutable-tuples") opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH -opt_NumbersStrict = lookUp FSLIT("-fnumbers-strict") opt_Parallel = lookUp FSLIT("-fparallel") opt_SMP = lookUp FSLIT("-fsmp") opt_Flatten = lookUp FSLIT("-fflatten") -- optimisation opts opt_NoMethodSharing = lookUp FSLIT("-fno-method-sharing") -opt_DoSemiTagging = lookUp FSLIT("-fsemi-tagging") opt_CprOff = lookUp FSLIT("-fcpr-off") opt_RulesOff = lookUp FSLIT("-frules-off") -- Switch off CPR analysis in the new demand analyser @@ -796,7 +780,6 @@ opt_EnsureSplittableC = lookUp FSLIT("-fglobalise-toplev-names") opt_GranMacros = lookUp FSLIT("-fgransim") opt_HiVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int opt_HistorySize = lookup_def_int "-fhistory-size" 20 -opt_NoHiCheck = lookUp FSLIT("-fno-hi-version-check") opt_OmitBlackHoling = lookUp FSLIT("-dno-black-holing") opt_RuntimeTypes = lookUp FSLIT("-fruntime-types") @@ -813,10 +796,8 @@ opt_UF_FunAppDiscount = lookup_def_int "-funfolding-fun-discount" (6::Int) - opt_UF_KeenessFactor = lookup_def_float "-funfolding-keeness-factor" (1.5::Float) opt_UF_UpdateInPlace = lookUp FSLIT("-funfolding-update-in-place") -opt_UF_CheapOp = ( 1 :: Int) -- Only one instruction; and the args are charged for opt_UF_DearOp = ( 4 :: Int) -opt_NoPruneDecls = lookUp FSLIT("-fno-prune-decls") opt_Static = lookUp FSLIT("-static") opt_Unregisterised = lookUp FSLIT("-funregisterised") opt_EmitExternalCore = lookUp FSLIT("-fext-core") @@ -840,7 +821,6 @@ isStaticHscFlag f = "fall-strict", "fdicts-strict", "firrefutable-tuples", - "fnumbers-strict", "fparallel", "fsmp", "fflatten", diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs index f01faf3..1a15ed8 100644 --- a/ghc/compiler/main/DriverMkDepend.hs +++ b/ghc/compiler/main/DriverMkDepend.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverMkDepend.hs,v 1.30 2003/07/18 13:18:07 simonmar Exp $ +-- $Id: DriverMkDepend.hs,v 1.31 2003/11/17 14:23:38 simonmar Exp $ -- -- GHC Driver -- @@ -7,7 +7,9 @@ -- ----------------------------------------------------------------------------- -module DriverMkDepend where +module DriverMkDepend ( + doMkDependHSPhase, beginMkDependHS, endMkDependHS + ) where #include "HsVersions.h" diff --git a/ghc/compiler/parser/Lexer.x b/ghc/compiler/parser/Lexer.x index ce7c02b..ccfc3e8 100644 --- a/ghc/compiler/parser/Lexer.x +++ b/ghc/compiler/parser/Lexer.x @@ -24,7 +24,7 @@ module Lexer ( Token(..), Token__(..), lexer, mkPState, showPFailed, P(..), ParseResult(..), setSrcLocFor, getSrcLoc, - failMsgP, failLocMsgP, srcParseFail, + failLocMsgP, srcParseFail, popContext, pushCurrentContext, ) where diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs index a9ac056..81c91cc 100644 --- a/ghc/compiler/prelude/PrimOp.lhs +++ b/ghc/compiler/prelude/PrimOp.lhs @@ -6,14 +6,11 @@ \begin{code} module PrimOp ( PrimOp(..), allThePrimOps, - primOpType, primOpSig, primOpArity, + primOpType, primOpSig, primOpTag, maxPrimOpTag, primOpOcc, - commutableOp, - primOpOutOfLine, primOpNeedsWrapper, primOpOkForSpeculation, primOpIsCheap, primOpIsDupable, - primOpHasSideEffects, getPrimOpResultInfo, PrimOpResultInfo(..) ) where @@ -368,14 +365,6 @@ primOpNeedsWrapper :: PrimOp -> Bool \end{code} \begin{code} -primOpArity :: PrimOp -> Arity -primOpArity op - = case (primOpInfo op) of - Monadic occ ty -> 1 - Dyadic occ ty -> 2 - Compare occ ty -> 2 - GenPrimOp occ tyvars arg_tys res_ty -> length arg_tys - primOpType :: PrimOp -> Type -- you may want to use primOpSig instead primOpType op = case (primOpInfo op) of diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs index 2b8f125..615d157 100644 --- a/ghc/compiler/typecheck/Inst.lhs +++ b/ghc/compiler/typecheck/Inst.lhs @@ -5,8 +5,6 @@ \begin{code} module Inst ( - LIE, emptyLIE, unitLIE, plusLIE, consLIE, - plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE, showLIE, Inst, diff --git a/ghc/compiler/types/Class.lhs b/ghc/compiler/types/Class.lhs index 71654f8..db5d597 100644 --- a/ghc/compiler/types/Class.lhs +++ b/ghc/compiler/types/Class.lhs @@ -10,8 +10,7 @@ module Class ( mkClass, classTyVars, classArity, classKey, className, classSelIds, classTyCon, - classBigSig, classExtraBigSig, classTvsFds, classSCTheta, - classHasFDs + classBigSig, classExtraBigSig, classTvsFds, classSCTheta ) where #include "HsVersions.h" @@ -115,9 +114,6 @@ classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps, classSCTheta = sc_theta, classSCSels = sc_sels, classOpStuff = op_stuff}) = (tyvars, fundeps, sc_theta, sc_sels, op_stuff) - -classHasFDs :: Class -> Bool -classHasFDs (Class {classFunDeps = fundeps}) = notNull fundeps \end{code} diff --git a/ghc/compiler/types/InstEnv.lhs b/ghc/compiler/types/InstEnv.lhs index a5f28a9..44f2db3 100644 --- a/ghc/compiler/types/InstEnv.lhs +++ b/ghc/compiler/types/InstEnv.lhs @@ -9,7 +9,7 @@ The bits common to TcInstDcls and TcDeriv. module InstEnv ( DFunId, InstEnv, - emptyInstEnv, extendInstEnv, pprInstEnv, + emptyInstEnv, extendInstEnv, lookupInstEnv, classInstEnv, simpleDFunClassTyCon, checkFunDeps ) where @@ -63,6 +63,7 @@ extendInstEnv inst_env dfun_id ins_tv_set = mkVarSet ins_tvs ins_item = (ins_tv_set, ins_tys, dfun_id) +#ifdef UNUSED pprInstEnv :: InstEnv -> SDoc pprInstEnv env = vcat [ brackets (pprWithCommas ppr (varSetElems tyvars)) <+> @@ -70,7 +71,7 @@ pprInstEnv env | cls_inst_env <- eltsUFM env , (tyvars, tys, dfun) <- cls_inst_env ] - +#endif simpleDFunClassTyCon :: DFunId -> (Class, TyCon) simpleDFunClassTyCon dfun diff --git a/ghc/compiler/utils/FastMutInt.lhs b/ghc/compiler/utils/FastMutInt.lhs index 09b535a..b483a14 100644 --- a/ghc/compiler/utils/FastMutInt.lhs +++ b/ghc/compiler/utils/FastMutInt.lhs @@ -7,8 +7,7 @@ \begin{code} module FastMutInt( FastMutInt, newFastMutInt, - readFastMutInt, writeFastMutInt, - incFastMutInt, incFastMutIntBy + readFastMutInt, writeFastMutInt ) where #include "MachDeps.h" @@ -50,18 +49,6 @@ writeFastMutInt :: FastMutInt -> Int -> IO () writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s -> case writeIntArray# arr 0# i s of { s -> (# s, () #) } - -incFastMutInt :: FastMutInt -> IO Int -- Returns original value -incFastMutInt (FastMutInt arr) = IO $ \s -> - case readIntArray# arr 0# s of { (# s, i #) -> - case writeIntArray# arr 0# (i +# 1#) s of { s -> - (# s, I# i #) } } - -incFastMutIntBy :: FastMutInt -> Int -> IO Int -- Returns original value -incFastMutIntBy (FastMutInt arr) (I# n) = IO $ \s -> - case readIntArray# arr 0# s of { (# s, i #) -> - case writeIntArray# arr 0# (i +# n) s of { s -> - (# s, I# i #) } } \end{code} #endif diff --git a/ghc/compiler/utils/PrimPacked.lhs b/ghc/compiler/utils/PrimPacked.lhs index f7f0201..1a47e30 100644 --- a/ghc/compiler/utils/PrimPacked.lhs +++ b/ghc/compiler/utils/PrimPacked.lhs @@ -11,18 +11,15 @@ subsystem, mostly. {-# OPTIONS -optc-DNON_POSIX_SOURCE #-} module PrimPacked ( - Ptr(..), nullPtr, writeCharOffPtr, plusAddr#, - BA(..), MBA(..), + Ptr(..), nullPtr, plusAddr#, + BA(..), packString, -- :: String -> (Int, BA) unpackNBytesBA, -- :: BA -> Int -> [Char] strLength, -- :: Ptr CChar -> Int copyPrefixStr, -- :: Addr# -> Int -> BA - copySubStr, -- :: Addr# -> Int -> Int -> BA copySubStrBA, -- :: BA -> Int -> Int -> BA eqStrPrefix, -- :: Addr# -> ByteArray# -> Int# -> Bool - eqCharStrPrefix, -- :: Addr# -> Addr# -> Int# -> Bool eqStrPrefixBA, -- :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool - eqCharStrPrefixBA, -- :: Addr# -> ByteArray# -> Int# -> Int# -> Bool ) where -- This #define suppresses the "import FastString" that @@ -70,11 +67,6 @@ nullPtr = Ptr (int2Addr# 0#) plusAddr# :: Addr# -> Int# -> Addr# plusAddr# a# i# = int2Addr# (addr2Int# a# +# i#) #endif - --- more compatibility: in 5.00+ we would use the Storable class for this, --- but 4.08 doesn't have it. -writeCharOffPtr (Ptr a#) (I# i#) (C# c#) = IO $ \s# -> - case writeCharOffAddr# a# i# c# s# of { s# -> (# s#, () #) } \end{code} Wrapper types for bytearrays @@ -154,9 +146,11 @@ Copying out a substring, assume a 0-indexed string: (and positive lengths, thank you). \begin{code} +#ifdef UNUSED copySubStr :: Addr# -> Int -> Int -> BA copySubStr a# (I# start#) length = copyPrefixStr (a# `plusAddr#` start#) length +#endif copySubStrBA :: BA -> Int -> Int -> BA copySubStrBA (BA barr#) (I# start#) len@(I# length#) = ba @@ -218,12 +212,13 @@ eqStrPrefix a# barr# len# = x <- memcmp_ba a# barr# (I# len#) return (x == 0) --- unused??? +#ifdef UNUSED eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool eqCharStrPrefix a1# a2# len# = unsafePerformIO $ do x <- memcmp a1# a2# (I# len#) return (x == 0) +#endif eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool eqStrPrefixBA b1# b2# start# len# = @@ -231,11 +226,13 @@ eqStrPrefixBA b1# b2# start# len# = x <- memcmp_baoff_ba b2# (I# start#) b1# (I# len#) return (x == 0) +#ifdef UNUSED eqCharStrPrefixBA :: Addr# -> ByteArray# -> Int# -> Int# -> Bool eqCharStrPrefixBA a# b2# start# len# = unsafePerformIO $ do x <- memcmp_baoff b2# (I# start#) a# (I# len#) return (x == 0) +#endif \end{code} \begin{code} diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs index b12745f..1a7020b 100644 --- a/ghc/compiler/utils/StringBuffer.lhs +++ b/ghc/compiler/utils/StringBuffer.lhs @@ -19,7 +19,6 @@ module StringBuffer prevChar, -- :: StringBuffer -> Char -> Char lookAhead, -- :: StringBuffer -> Int -> Char atEnd, -- :: StringBuffer -> Bool - difference, -- :: StringBuffer -> StringBuffer -> Int -- * Moving stepOn, stepOnBy, @@ -143,9 +142,6 @@ lookAhead (StringBuffer arr# l# c#) (I# i#) = where off = c# +# i# -difference :: StringBuffer -> StringBuffer -> Int -difference (StringBuffer _ _ c1#) (StringBuffer _ _ c2#) = I# (c2# -# c1#) - -- ----------------------------------------------------------------------------- -- Moving -- 1.7.10.4