Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
4166dff8
Commit
4166dff8
authored
Nov 24, 2000
by
simonpj
Browse files
[project @ 2000-11-24 09:51:38 by simonpj]
Unused imports and suchlike
parent
562926d7
Changes
26
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/absCSyn/AbsCUtils.lhs
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgExpr.lhs,v 1.
39
2000/11/
15 17:07
:3
4
simonpj Exp $
% $Id: CgExpr.lhs,v 1.
40
2000/11/
24 09:51
:3
8
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,
splitT
yConApp, tyConAppTyCon, repType )
import Type ( Type, typePrimRep,
t
yConApp
Args
, 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
) = splitT
yConApp (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
= t
yConApp
Args
(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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.2
3
2000/11/2
2 12:19:2
9 simon
mar
Exp $
-- $Id: DriverFlags.hs,v 1.2
4
2000/11/2
4 09:51:3
9 simon
pj
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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
{-# OPTIONS -W -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
-- $Id: Main.hs,v 1.3
2
2000/11/2
2 17
:51:
16
simon
mar
Exp $
-- $Id: Main.hs,v 1.3
3
2000/11/2
4 09
:51:
39
simon
pj
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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
View file @
4166dff8
...
...
@@ -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
...
...
Prev
1
2
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment