Commit 4166dff8 authored by simonpj's avatar simonpj

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

Unused imports and suchlike
parent 562926d7
......@@ -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
......
......@@ -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}
......
......@@ -13,7 +13,6 @@ import CgMonad
import AbsCUtils ( mkAbstractCs, mkAbsCStmts )
import CgTailCall ( performReturn, mkStaticAlgReturnCode )
import CLabel ( mkConEntryLabel )
import ClosureInfo ( layOutStaticClosure, layOutDynCon,
mkConLFInfo, ClosureInfo
)
......
%
% (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}
......@@ -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
......
......@@ -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
)
......
......@@ -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
......
......@@ -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}
......
-----------------------------------------------------------------------------
-- $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
......
......@@ -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
......
{-# 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
......
......@@ -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)
......
......@@ -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,
......
......@@ -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}
%************************************************************************
......
......@@ -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)
......
......@@ -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) })
......
......@@ -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)
......
......@@ -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
......
......@@ -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')
......
......@@ -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
......
......@@ -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
......
......@@ -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}
......
......@@ -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 )
......
......@@ -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
......
......@@ -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
......
......@@ -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 )
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment