From 4166dff80e8ec94022a040318ff2759913fbbe06 Mon Sep 17 00:00:00 2001 From: simonpj Date: Fri, 24 Nov 2000 09:51:41 +0000 Subject: [PATCH] [project @ 2000-11-24 09:51:38 by simonpj] Unused imports and suchlike --- ghc/compiler/absCSyn/AbsCUtils.lhs | 2 +- ghc/compiler/basicTypes/Id.lhs | 15 +++++++++----- ghc/compiler/codeGen/CgConTbls.lhs | 1 - ghc/compiler/codeGen/CgExpr.lhs | 13 ++++++------ ghc/compiler/compMan/CompManager.lhs | 2 +- ghc/compiler/deSugar/DsForeign.lhs | 3 +-- ghc/compiler/deSugar/DsListComp.lhs | 2 +- ghc/compiler/main/CodeOutput.lhs | 5 ++++- ghc/compiler/main/DriverFlags.hs | 5 +++-- ghc/compiler/main/HscTypes.lhs | 20 ++----------------- ghc/compiler/main/Main.hs | 13 +++++++----- ghc/compiler/nativeGen/MachCode.lhs | 5 ++--- ghc/compiler/rename/Rename.lhs | 2 +- ghc/compiler/rename/RnBinds.lhs | 2 -- ghc/compiler/rename/RnExpr.lhs | 2 +- ghc/compiler/rename/RnIfaces.lhs | 4 ---- ghc/compiler/rename/RnNames.lhs | 4 ++-- ghc/compiler/simplCore/SetLevels.lhs | 1 - ghc/compiler/simplCore/SimplCore.lhs | 4 ++-- ghc/compiler/simplStg/SimplStg.lhs | 35 ++++++++++++++++----------------- ghc/compiler/simplStg/StgVarInfo.lhs | 2 +- ghc/compiler/stranal/WwLib.lhs | 2 +- ghc/compiler/typecheck/TcInstDcls.lhs | 2 +- ghc/compiler/typecheck/TcMatches.lhs | 2 +- ghc/compiler/types/TyCon.lhs | 4 +++- ghc/compiler/types/TypeRep.lhs | 2 +- 26 files changed, 70 insertions(+), 84 deletions(-) diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs index a5a36c8..3a1bd47 100644 --- a/ghc/compiler/absCSyn/AbsCUtils.lhs +++ b/ghc/compiler/absCSyn/AbsCUtils.lhs @@ -111,7 +111,7 @@ mkAlgAltsCSwitch scrutinee tagged_alts deflt_absc -- it's ok to convert one of the alts into a default if we don't already have -- one, because this is an algebraic case and we're guaranteed that the tag -- will match one of the branches. - ((tag,first_alt):rest) = tagged_alts + ((_,first_alt):rest) = tagged_alts -- Adjust the tags in the switch to start at zero. -- This is the convention used by primitive ops which return algebraic diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs index c26f7aa..0864777 100644 --- a/ghc/compiler/basicTypes/Id.lhs +++ b/ghc/compiler/basicTypes/Id.lhs @@ -256,11 +256,16 @@ isLocalId :: Id -> Bool -- True of Ids that are locally defined, but are not constants -- like data constructors, record selectors, and the like. -- See comments with CoreFVs.isLocalVar -isLocalId id = case idFlavour id of - VanillaId -> True - ExportedId -> True - SpecPragmaId -> True - other -> False +isLocalId id +#ifdef DEBUG + | not (isId id) = pprTrace "isLocalid" (ppr id) False + | otherwise +#endif + = case idFlavour id of + VanillaId -> True + ExportedId -> True + SpecPragmaId -> True + other -> False \end{code} diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs index 299eceb..9c205cc 100644 --- a/ghc/compiler/codeGen/CgConTbls.lhs +++ b/ghc/compiler/codeGen/CgConTbls.lhs @@ -13,7 +13,6 @@ import CgMonad import AbsCUtils ( mkAbstractCs, mkAbsCStmts ) import CgTailCall ( performReturn, mkStaticAlgReturnCode ) -import CLabel ( mkConEntryLabel ) import ClosureInfo ( layOutStaticClosure, layOutDynCon, mkConLFInfo, ClosureInfo ) diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs index ca015bd..8e8b5e2 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.39 2000/11/15 17:07:34 simonpj Exp $ +% $Id: CgExpr.lhs,v 1.40 2000/11/24 09:51:38 simonpj Exp $ % %******************************************************** %* * @@ -39,12 +39,11 @@ import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo, import CostCentre ( sccAbleCostCentre, isSccCountCostCentre ) import Id ( idPrimRep, idType, Id ) import VarSet -import DataCon ( dataConTyCon ) import PrimOp ( primOpOutOfLine, getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..) ) import PrimRep ( PrimRep(..), isFollowableRep ) import TyCon ( maybeTyConSingleCon, isUnboxedTupleTyCon, isEnumerationTyCon ) -import Type ( Type, typePrimRep, splitTyConApp, tyConAppTyCon, repType ) +import Type ( Type, typePrimRep, tyConAppArgs, tyConAppTyCon, repType ) import Maybes ( maybeToBool ) import ListSetOps ( assocMaybe ) import Unique ( mkBuiltinUnique ) @@ -462,10 +461,10 @@ primRetUnboxedTuple op args res_ty allocate some temporaries for the return values. -} let - (tc,ty_args) = splitTyConApp (repType res_ty) - prim_reps = map typePrimRep ty_args - temp_uniqs = map mkBuiltinUnique [ n_args .. n_args + length ty_args - 1] - temp_amodes = zipWith CTemp temp_uniqs prim_reps + ty_args = tyConAppArgs (repType res_ty) + prim_reps = map typePrimRep ty_args + temp_uniqs = map mkBuiltinUnique [ n_args .. n_args + length ty_args - 1] + temp_amodes = zipWith CTemp temp_uniqs prim_reps in returnUnboxedTuple temp_amodes (absC (COpStmt temp_amodes op arg_temps [])) \end{code} diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index d489559..60dec5a 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -25,7 +25,6 @@ import DriverPipeline import GetImports import HscTypes ( HomeSymbolTable, HomeIfaceTable, PersistentCompilerState, ModDetails(..) ) -import Type ( Type ) import Name ( lookupNameEnv ) import Module import PrelNames ( mainName ) @@ -48,6 +47,7 @@ import CmdLineOpts ( DynFlags(..) ) import Interpreter ( HValue ) import HscMain ( hscExpr, hscTypeExpr ) import RdrName +import Type ( Type ) import PrelGHC ( unsafeCoerce# ) #endif diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs index 189672a..a1f34d6 100644 --- a/ghc/compiler/deSugar/DsForeign.lhs +++ b/ghc/compiler/deSugar/DsForeign.lhs @@ -29,8 +29,7 @@ import Name ( mkGlobalName, nameModule, nameOccName, getOccString, mkForeignExportOcc, isLocalName, NamedThing(..), ) -import Type ( repType, - splitTyConApp_maybe, tyConAppTyCon, splitFunTys, splitForAllTys, +import Type ( splitTyConApp_maybe, tyConAppTyCon, splitFunTys, splitForAllTys, Type, mkFunTys, mkForAllTys, mkTyConApp, mkFunTy, splitAppTy, applyTy, funResultTy ) diff --git a/ghc/compiler/deSugar/DsListComp.lhs b/ghc/compiler/deSugar/DsListComp.lhs index 2d532e3..633c137 100644 --- a/ghc/compiler/deSugar/DsListComp.lhs +++ b/ghc/compiler/deSugar/DsListComp.lhs @@ -136,7 +136,7 @@ deListComp (ParStmtOut bndrstmtss : quals) list in newSysLocalDs zipTy `thenDs` \ zipFn -> let target = mkConsExpr retTy (mkTupleExpr as) (foldl App (Var zipFn) (map Var as's)) - zipExp = mkLet zipFn (zip4 (map fst bndrstmtss) ass as as's) exps target + zipExp = mkLet zipFn (zip4 bndrss ass as as's) exps target in deBindComp pat zipExp quals list where (bndrss, stmtss) = unzip bndrstmtss diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs index 896e151..84f5645 100644 --- a/ghc/compiler/main/CodeOutput.lhs +++ b/ghc/compiler/main/CodeOutput.lhs @@ -22,6 +22,7 @@ import qualified PrintJava import TyCon ( TyCon ) import Id ( Id ) import CoreSyn ( CoreBind ) +import OccurAnal ( occurAnalyseBinds ) import StgSyn ( StgBinding ) import AbsCSyn ( AbstractC ) import PprAbsC ( dumpRealC, writeRealC ) @@ -135,7 +136,9 @@ outputJava dflags filenm mod tycons core_binds = doOutput filenm (\ f -> printForUser f alwaysQualify pp_java) -- User style printing for now to keep indentation where - java_code = javaGen mod [{- Should be imports-}] tycons core_binds + occ_anal_binds = occurAnalyseBinds core_binds + -- Make sure we have up to date dead-var information + java_code = javaGen mod [{- Should be imports-}] tycons occ_anal_binds pp_java = PrintJava.compilationUnit java_code \end{code} diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index e07ec11..2c90276 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.23 2000/11/22 12:19:29 simonmar Exp $ +-- $Id: DriverFlags.hs,v 1.24 2000/11/24 09:51:39 simonpj Exp $ -- -- Driver flags -- @@ -18,7 +18,8 @@ import TmpFiles ( v_TmpDir ) import CmdLineOpts import Config import Util - +import TmpFiles ( newTempName ) +import Directory ( removeFile ) import Exception import IOExts import IO diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 49f12f2..e2a83c6 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -150,24 +150,8 @@ mkIfaceDecls tycls rules insts dcl_rules = sortLt lt_rule rules, dcl_insts = insts } where - d1 `lt_tycl` d2 = nameOccName (tyClDeclName d1) < nameOccName (tyClDeclName d2) - r1 `lt_rule` r2 = nameOccName (ifaceRuleDeclName r1) < nameOccName (ifaceRuleDeclName r2) - - -- I wanted to sort just by the Name, but there's a problem: we are comparing - -- the old version of an interface with the new version. The latter will use - -- local names like 'lvl23' that were constructed not by the renamer but by - -- the simplifier. So the unqiues aren't going to line up. - -- - -- It's ok to compare by OccName because this comparison only drives the - -- computation of new version numbers. - -- - -- Better solutions: Compare in a way that is insensitive to the name used - -- for local things. This would decrease the wobbles due - -- to 'lvl23' changing to 'lvl24'. - -- - -- NB: there's a related comparision on MkIface.diffDecls! - - + d1 `lt_tycl` d2 = tyClDeclName d1 < tyClDeclName d2 + r1 `lt_rule` r2 = ifaceRuleDeclName r1 < ifaceRuleDeclName r2 -- typechecker should only look at this, not ModIface diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index 99cd07a..13aa963 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,6 +1,6 @@ {-# OPTIONS -W -fno-warn-incomplete-patterns #-} ----------------------------------------------------------------------------- --- $Id: Main.hs,v 1.32 2000/11/22 17:51:16 simonmar Exp $ +-- $Id: Main.hs,v 1.33 2000/11/24 09:51:39 simonpj Exp $ -- -- GHC Driver program -- @@ -15,11 +15,14 @@ module Main (main) where #include "HsVersions.h" -import CompManager -import Interpreter + #ifdef GHCI +import Interpreter import InteractiveUI +import Dynamic #endif + +import CompManager import DriverPipeline import DriverState import DriverFlags @@ -28,13 +31,14 @@ import DriverUtil import Panic import DriverPhases ( Phase(..) ) import CmdLineOpts ( HscLang(..), DynFlags(..), v_Static_hsc_opts ) -import Module ( mkModuleName ) import TmpFiles import Finder ( initFinder ) import CmStaticInfo import Config import Util + + import Concurrent #ifndef mingw32_TARGET_OS import Posix @@ -42,7 +46,6 @@ import Posix import Directory import IOExts import Exception -import Dynamic import IO import Monad diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index df4c2a6..8ff6ffe 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -20,7 +20,7 @@ import OrdList ( OrdList, nilOL, isNilOL, unitOL, appOL, toOL, snocOL, consOL, concatOL ) import AbsCUtils ( magicIdPrimRep ) import CallConv ( CallConv ) -import CLabel ( isAsmTemp, CLabel, pprCLabel_asm, labelDynamic ) +import CLabel ( isAsmTemp, CLabel, labelDynamic ) import Maybes ( maybeToBool, expectJust ) import PrimRep ( isFloatingRep, PrimRep(..) ) import PrimOp ( PrimOp(..) ) @@ -28,7 +28,7 @@ import CallConv ( cCallConv ) import Stix ( getNatLabelNCG, StixTree(..), StixReg(..), CodeSegment(..), DestInfo, hasDestInfo, - pprStixTree, ppStixReg, + pprStixTree, NatM, thenNat, returnNat, mapNat, mapAndUnzipNat, mapAccumLNat, getDeltaNat, setDeltaNat @@ -2203,7 +2203,6 @@ genCondJump lbl bool let code = condCode condition cond = condName condition - target = ImmCLbl lbl in returnNat (code `snocOL` JXX cond lbl) diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index e6d1d4f..9e28cd9 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -38,7 +38,7 @@ import RnEnv ( availsToNameSet, availName, mkIfaceGlobalRdrEnv, ) import Module ( Module, ModuleName, WhereFrom(..), moduleNameUserString, moduleName, - moduleEnvElts, lookupModuleEnv + moduleEnvElts ) import Name ( Name, NamedThing(..), getSrcLoc, nameIsLocalOrFrom, nameOccName, nameModule, diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs index bc82621..1da2f9c 100644 --- a/ghc/compiler/rename/RnBinds.lhs +++ b/ghc/compiler/rename/RnBinds.lhs @@ -69,8 +69,6 @@ within one @MonoBinds@, so that unique-Int plumbing is done explicitly \begin{code} type VertexTag = Int -type Cycle = [VertexTag] -type Edge = (VertexTag, VertexTag) \end{code} %************************************************************************ diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs index a881534..009facd 100644 --- a/ghc/compiler/rename/RnExpr.lhs +++ b/ghc/compiler/rename/RnExpr.lhs @@ -562,7 +562,7 @@ rnStmt :: RnExprTy -> RdrNameStmt rnStmt rn_expr (ParStmt stmtss) thing_inside = mapFvRn (rnStmts rn_expr) stmtss `thenRn` \ (bndrstmtss, fv_stmtss) -> - let (binderss, stmtss') = unzip bndrstmtss + let binderss = map fst bndrstmtss checkBndrs all_bndrs bndrs = checkRn (null (intersectBy eqOcc all_bndrs bndrs)) err `thenRn_` returnRn (bndrs ++ all_bndrs) diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs index e62b780..a9334eb 100644 --- a/ghc/compiler/rename/RnIfaces.lhs +++ b/ghc/compiler/rename/RnIfaces.lhs @@ -322,10 +322,6 @@ rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl) `thenRn` \ dec \begin{code} -getSlurped - = getIfacesRn `thenRn` \ ifaces -> - returnRn (iSlurp ifaces) - recordSlurp ifaces@(Ifaces { iDecls = (decls_map, n_slurped), iSlurp = slurped_names, iVSlurp = (imp_mods, imp_names) }) diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 683dfd8..5dc3100 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -195,8 +195,8 @@ importsFromLocalDecls this_mod decls unqual_imp = True -- Want unqualified names mk_prov n = LocalDef -- Provenance is local hides = [] -- Hide nothing - gbl_env = mkGlobalRdrEnv mod_name unqual_imp [] mk_prov avails - exports = mkExportAvails mod_name unqual_imp gbl_env avails + gbl_env = mkGlobalRdrEnv mod_name unqual_imp hides mk_prov avails + exports = mkExportAvails mod_name unqual_imp gbl_env avails in returnRn (gbl_env, exports) diff --git a/ghc/compiler/simplCore/SetLevels.lhs b/ghc/compiler/simplCore/SetLevels.lhs index 4127f52..40366cf 100644 --- a/ghc/compiler/simplCore/SetLevels.lhs +++ b/ghc/compiler/simplCore/SetLevels.lhs @@ -111,7 +111,6 @@ at @Level 0 0@. \begin{code} type LevelledExpr = TaggedExpr Level -type LevelledArg = TaggedArg Level type LevelledBind = TaggedBind Level tOP_LEVEL = Level 0 0 diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs index b5ec550..55023e7 100644 --- a/ghc/compiler/simplCore/SimplCore.lhs +++ b/ghc/compiler/simplCore/SimplCore.lhs @@ -105,8 +105,8 @@ simplifyExpr dflags pcs hst expr ; us <- mkSplitUniqSupply 's' - ; let (expr', counts) = initSmpl dflags sw_chkr us emptyVarSet black_list_all - (simplExpr expr) + ; let (expr', _counts) = initSmpl dflags sw_chkr us emptyVarSet black_list_all + (simplExpr expr) ; dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplfied expression" (pprCoreExpr expr') diff --git a/ghc/compiler/simplStg/SimplStg.lhs b/ghc/compiler/simplStg/SimplStg.lhs index e766257..d4c558d 100644 --- a/ghc/compiler/simplStg/SimplStg.lhs +++ b/ghc/compiler/simplStg/SimplStg.lhs @@ -24,8 +24,8 @@ import CmdLineOpts ( DynFlags, DynFlag(..), dopt, ) import Id ( Id ) import Module ( Module ) -import ErrUtils ( doIfSet_dyn, dumpIfSet_dyn ) -import UniqSupply ( splitUniqSupply, UniqSupply ) +import ErrUtils ( doIfSet_dyn, dumpIfSet_dyn, showPass ) +import UniqSupply ( mkSplitUniqSupply, splitUniqSupply, UniqSupply ) import IO ( hPutStr, stdout ) import Outputable \end{code} @@ -42,19 +42,20 @@ stg2stg :: DynFlags -- includes spec of what stg-to-stg passes to do [CostCentreStack])) -- pre-defined "singleton" cost centre stacks stg2stg dflags module_name us binds - = case (splitUniqSupply us) of { (us4now, us4later) -> + = do { showPass dflags "Stg2Stg" + ; us <- mkSplitUniqSupply 'g' - doIfSet_dyn dflags Opt_D_verbose_stg2stg (printDump (text "VERBOSE STG-TO-STG:")) >> + ; doIfSet_dyn dflags Opt_D_verbose_stg2stg + (printDump (text "VERBOSE STG-TO-STG:")) - end_pass us4now "Core2Stg" ([],[],[]) binds - >>= \ (binds', us, ccs) -> + ; (binds', us', ccs) <- end_pass us "Core2Stg" ([],[],[]) binds - -- Do the main business! - foldl_mn do_stg_pass (binds', us, ccs) (dopt_StgToDo dflags) - >>= \ (processed_binds, _, cost_centres) -> - - -- Do essential wind-up + -- Do the main business! + ; (processed_binds, _, cost_centres) + <- foldl_mn do_stg_pass (binds', us', ccs) + (dopt_StgToDo dflags) + -- Do essential wind-up -- Essential wind-up: part (b), do setStgVarInfo. It has to -- happen regardless, because the code generator uses its -- decorations. @@ -66,15 +67,13 @@ stg2stg dflags module_name us binds -- correct, which is done by satStgRhs. -- - let - annotated_binds = setStgVarInfo opt_StgDoLetNoEscapes processed_binds - srt_binds = computeSRTs annotated_binds - in + ; let annotated_binds = setStgVarInfo opt_StgDoLetNoEscapes processed_binds + srt_binds = computeSRTs annotated_binds - dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" - (pprStgBindingsWithSRTs srt_binds) >> + ; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" + (pprStgBindingsWithSRTs srt_binds) - return (srt_binds, cost_centres) + ; return (srt_binds, cost_centres) } where diff --git a/ghc/compiler/simplStg/StgVarInfo.lhs b/ghc/compiler/simplStg/StgVarInfo.lhs index 88f76bb..624a89c 100644 --- a/ghc/compiler/simplStg/StgVarInfo.lhs +++ b/ghc/compiler/simplStg/StgVarInfo.lhs @@ -21,7 +21,7 @@ import IdInfo ( ArityInfo(..), OccInfo(..) ) import PrimOp ( PrimOp(..), ccallMayGC ) import TysWiredIn ( isForeignObjTy ) import Maybes ( maybeToBool, orElse ) -import Name ( isLocalName, getOccName ) +import Name ( getOccName ) import OccName ( occNameUserString ) import BasicTypes ( Arity ) import Outputable diff --git a/ghc/compiler/stranal/WwLib.lhs b/ghc/compiler/stranal/WwLib.lhs index dc70984..65e65e4 100644 --- a/ghc/compiler/stranal/WwLib.lhs +++ b/ghc/compiler/stranal/WwLib.lhs @@ -502,7 +502,7 @@ mkWWcpr body_ty ReturnsCPR \ body -> Case body work_wild [(DataAlt data_con, args, ubx_tup_app)], ubx_tup_ty) where - (tycon, tycon_arg_tys, data_con, con_arg_tys) = splitProductType "mkWWcpr" body_ty + (_, tycon_arg_tys, data_con, con_arg_tys) = splitProductType "mkWWcpr" body_ty n_con_args = length con_arg_tys con_arg_ty1 = head con_arg_tys \end{code} diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs index 87c62f7..2a95703 100644 --- a/ghc/compiler/typecheck/TcInstDcls.lhs +++ b/ghc/compiler/typecheck/TcInstDcls.lhs @@ -33,7 +33,7 @@ import TcEnv ( TcEnv, tcExtendGlobalValEnv, InstInfo(..), pprInstInfo, simpleInstInfoTyCon, simpleInstInfoTy, newDFunName, tcExtendTyVarEnv ) -import InstEnv ( InstEnv, extendInstEnv, pprInstEnv ) +import InstEnv ( InstEnv, extendInstEnv ) import TcMonoType ( tcTyVars, tcHsSigType, kcHsSigType ) import TcSimplify ( tcSimplifyAndCheck ) import TcType ( zonkTcSigTyVars ) diff --git a/ghc/compiler/typecheck/TcMatches.lhs b/ghc/compiler/typecheck/TcMatches.lhs index 8ac55c5..7fa3790 100644 --- a/ghc/compiler/typecheck/TcMatches.lhs +++ b/ghc/compiler/typecheck/TcMatches.lhs @@ -284,7 +284,7 @@ tcStmts :: StmtCtxt -> TcM (([TcStmt], [(Name, TcId)]), LIE) tcStmts do_or_lc m elt_ty loc (ParStmtOut bndrstmtss : stmts) - = let (bndrss, stmtss) = unzip bndrstmtss in + = let stmtss = map snd bndrstmtss in mapAndUnzip3Tc (tcParStep loc) stmtss `thenTc` \ (stmtss', val_envs, lies) -> let outstmts = zip (map (map snd) val_envs) stmtss' lie = plusLIEs lies diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs index 5592d00..a4bf2bc 100644 --- a/ghc/compiler/types/TyCon.lhs +++ b/ghc/compiler/types/TyCon.lhs @@ -387,7 +387,9 @@ isRecursiveTyCon other = False \begin{code} tyConDataCons :: TyCon -> [DataCon] -tyConDataCons tycon = ASSERT2( not (null cons), ppr tycon ) cons +tyConDataCons tycon = ASSERT2( not (null cons), ppr tycon ) + ASSERT2( length cons == tyConFamilySize tycon, ppr tycon ) + cons where cons = tyConDataConsIfAvailable tycon diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs index a533cd5..2a9acad 100644 --- a/ghc/compiler/types/TypeRep.lhs +++ b/ghc/compiler/types/TypeRep.lhs @@ -32,7 +32,7 @@ import Var ( TyVar ) import VarEnv import VarSet -import Name ( Name, tcName ) +import Name ( Name ) import TyCon ( TyCon, KindCon, mkFunTyCon, mkKindCon, mkSuperKindCon ) import Class ( Class ) -- 1.7.10.4