[project @ 2000-11-24 09:51:38 by simonpj]

Unused imports and suchlike

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

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}
 
 

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
 			)

ghc/compiler/codeGen/CgExpr.lhs

 %
 % (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}

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
 

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
 			)

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

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}
 

ghc/compiler/main/DriverFlags.hs

 -----------------------------------------------------------------------------
--- $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

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

ghc/compiler/main/Main.hs

 {-# 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

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)
 

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,

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}
 
 %************************************************************************

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)

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) })

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)
 

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

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')

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