Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
obsidiansystems
GHC
Commits
084c8a02
Commit
084c8a02
authored
Jul 11, 2000
by
simonmar
Browse files
[project @ 2000-07-11 16:03:37 by simonmar]
remove unused imports; misc cleanup
parent
1f3a9da2
Changes
11
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/codeGen/CgBindery.lhs
View file @
084c8a02
...
...
@@ -32,7 +32,7 @@ import AbsCSyn
import CgMonad
import CgUsages ( getHpRelOffset, getSpRelOffset, getRealSp )
import CgStackery ( freeStackSlots
, addFreeSlots
)
import CgStackery ( freeStackSlots )
import CLabel ( mkClosureLabel,
mkBitmapLabel, pprCLabel )
import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
...
...
@@ -45,7 +45,7 @@ import VarEnv
import VarSet ( varSetElems )
import Literal ( Literal )
import Maybes ( catMaybes, maybeToBool )
import Name ( isLocallyDefined,
isWiredInName,
NamedThing(..) )
import Name ( isLocallyDefined, NamedThing(..) )
#ifdef DEBUG
import PprAbsC ( pprAmode )
#endif
...
...
ghc/compiler/codeGen/CgCase.lhs
View file @
084c8a02
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgCase.lhs,v 1.4
2
2000/0
5/25 12:41:15
simon
pj
Exp $
% $Id: CgCase.lhs,v 1.4
3
2000/0
7/11 16:03:37
simon
mar
Exp $
%
%********************************************************
%* *
...
...
@@ -25,7 +25,7 @@ import AbsCUtils ( mkAbstractCs, mkAbsCStmts, mkAlgAltsCSwitch,
getAmodeRep, nonemptyAbsC
)
import CgUpdate ( reserveSeqFrame )
import CgBindery ( getVolatileRegs, getArgAmodes,
getArgAmode,
import CgBindery ( getVolatileRegs, getArgAmodes,
bindNewToReg, bindNewToTemp,
bindNewPrimToAmode,
rebindToStack, getCAddrMode,
...
...
@@ -48,7 +48,6 @@ import CLabel ( CLabel, mkVecTblLabel, mkReturnPtLabel,
)
import ClosureInfo ( mkLFArgument )
import CmdLineOpts ( opt_SccProfilingOn, opt_GranMacros )
import CostCentre ( CostCentre )
import Id ( Id, idPrimRep, isDeadBinder )
import DataCon ( DataCon, dataConTag, fIRST_TAG, ConTag,
isUnboxedTupleCon )
...
...
@@ -62,7 +61,6 @@ import TyCon ( TyCon, isEnumerationTyCon, isUnboxedTupleTyCon,
)
import Type ( Type, typePrimRep, splitAlgTyConApp,
splitTyConApp_maybe, repType )
import PprType ( {- instance Outputable Type -} )
import Unique ( Unique, Uniquable(..), mkPseudoUnique1 )
import Maybes ( maybeToBool )
import Util
...
...
ghc/compiler/codeGen/CgConTbls.lhs
View file @
084c8a02
...
...
@@ -11,7 +11,6 @@ module CgConTbls ( genStaticConBits ) where
import AbsCSyn
import CgMonad
import StgSyn ( SRT(..) )
import AbsCUtils ( mkAbstractCs, mkAbsCStmts )
import CgTailCall ( performReturn, mkStaticAlgReturnCode )
import CLabel ( mkConEntryLabel )
...
...
@@ -19,14 +18,12 @@ import ClosureInfo ( layOutStaticClosure, layOutDynCon,
mkConLFInfo, ClosureInfo
)
import CostCentre ( dontCareCCS )
import FiniteMap ( fmToList, FiniteMap )
import DataCon ( DataCon, dataConName, dataConRepArgTys, isNullaryDataCon )
import Name ( getOccName )
import OccName ( occNameUserString )
import PrimRep ( getPrimRepSize, PrimRep(..) )
import TyCon ( tyConDataCons, isEnumerationTyCon, TyCon )
import Type ( typePrimRep, Type )
import Outputable
import Type ( typePrimRep )
\end{code}
For every constructor we generate the following info tables:
...
...
ghc/compiler/codeGen/CgExpr.lhs
View file @
084c8a02
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgExpr.lhs,v 1.3
4
2000/0
4
/1
3 20:41:30 panne
Exp $
% $Id: CgExpr.lhs,v 1.3
5
2000/0
7
/1
1 16:03:37 simonmar
Exp $
%
%********************************************************
%* *
...
...
@@ -40,7 +40,6 @@ import CostCentre ( sccAbleCostCentre, isSccCountCostCentre )
import Id ( idPrimRep, idType, Id )
import VarSet
import DataCon ( DataCon, dataConTyCon )
import IdInfo ( ArityInfo(..) )
import PrimOp ( primOpOutOfLine, ccallMayGC,
getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..)
)
...
...
@@ -48,7 +47,6 @@ import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep )
import TyCon ( maybeTyConSingleCon,
isUnboxedTupleTyCon, isEnumerationTyCon )
import Type ( Type, typePrimRep, splitTyConApp_maybe, repType )
import PprType ( {- instance Outputable Type -} )
import Maybes ( assocMaybe, maybeToBool )
import Unique ( mkBuiltinUnique )
import BasicTypes ( TopLevelFlag(..), RecFlag(..) )
...
...
ghc/compiler/codeGen/CgHeapery.lhs
View file @
084c8a02
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgHeapery.lhs,v 1.2
0
2000/0
1/13 14:33:58 hwloidl
Exp $
% $Id: CgHeapery.lhs,v 1.2
1
2000/0
7/11 16:03:37 simonmar
Exp $
%
\section[CgHeapery]{Heap management functions}
...
...
@@ -21,7 +21,6 @@ import CLabel
import CgMonad
import CgStackery ( getFinalStackHW, mkTaggedStkAmodes, mkTagAssts )
import SMRep ( fixedHdrSize )
import AbsCUtils ( mkAbstractCs, getAmodeRep )
import CgUsages ( getVirtAndRealHp, getRealSp, setVirtHp, setRealHp,
initHeapUsage
...
...
ghc/compiler/codeGen/CgLetNoEscape.lhs
View file @
084c8a02
%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
% $Id: CgLetNoEscape.lhs,v 1.1
3 1999
/0
5
/1
3
1
7:30:5
7 simonm Exp $
% $Id: CgLetNoEscape.lhs,v 1.1
4 2000
/0
7
/1
1
1
6:03:3
7 simonm
ar
Exp $
%
%********************************************************
%* *
...
...
@@ -19,7 +19,6 @@ import {-# SOURCE #-} CgExpr ( cgExpr )
import StgSyn
import CgMonad
import AbsCSyn
import CLabel ( CLabel )
import CgBindery ( letNoEscapeIdInfo, bindArgsToRegs,
bindNewToStack, buildContLivenessMask, CgIdInfo,
...
...
ghc/compiler/codeGen/CgMonad.lhs
View file @
084c8a02
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgMonad.lhs,v 1.2
3 1999/10
/1
3
16:
39:16
simonmar Exp $
% $Id: CgMonad.lhs,v 1.2
4 2000/07
/1
1
16:
03:37
simonmar Exp $
%
\section[CgMonad]{The code generation monad}
...
...
@@ -54,7 +54,6 @@ import DataCon ( ConTag )
import Id ( Id )
import VarEnv
import PrimRep ( PrimRep(..) )
import StgSyn ( StgLiveVars )
import Outputable
infixr 9 `thenC` -- Right-associative!
...
...
ghc/compiler/codeGen/CgRetConv.lhs
View file @
084c8a02
%
% (c) The GRASP Project, Glasgow University, 1992-1998
%
% $Id: CgRetConv.lhs,v 1.2
2
2000/0
5/25 12:41:15
simon
pj
Exp $
% $Id: CgRetConv.lhs,v 1.2
3
2000/0
7/11 16:03:37
simon
mar
Exp $
%
\section[CgRetConv]{Return conventions for the code generator}
...
...
@@ -27,11 +27,8 @@ import CmdLineOpts ( opt_UseVanillaRegs, opt_UseFloatRegs,
opt_UseDoubleRegs, opt_UseLongRegs
)
import Maybes ( catMaybes )
import DataCon ( DataCon )
import PrimOp ( PrimOp{-instance Outputable-} )
import PrimRep ( isFloatingRep, PrimRep(..), is64BitRep )
import TyCon ( TyCon, tyConFamilySize )
import Type ( Type, typePrimRep, isUnLiftedType )
import Util ( isn'tIn )
import Outputable
...
...
ghc/compiler/codeGen/CgTailCall.lhs
View file @
084c8a02
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgTailCall.lhs,v 1.2
4
2000/0
3/23 17:45:19
simon
pj
Exp $
% $Id: CgTailCall.lhs,v 1.2
5
2000/0
7/11 16:03:37
simon
mar
Exp $
%
%********************************************************
%* *
...
...
@@ -30,7 +30,7 @@ import CgMonad
import AbsCSyn
import PprAbsC ( pprAmode )
import AbsCUtils ( mkAbstractCs,
mkAbsCStmts,
getAmodeRep )
import AbsCUtils ( mkAbstractCs, getAmodeRep )
import CgBindery ( getArgAmodes, getCAddrMode, getCAddrModeAndInfo )
import CgRetConv ( dataReturnConvPrim,
ctrlReturnConvAlg, CtrlReturnConvention(..),
...
...
@@ -48,7 +48,6 @@ import ClosureInfo ( nodeMustPointToIt,
import CmdLineOpts ( opt_DoSemiTagging )
import Id ( Id, idType, idName )
import DataCon ( DataCon, dataConTyCon, dataConTag, fIRST_TAG )
import Literal ( mkMachInt )
import Maybes ( assocMaybe, maybeToBool )
import PrimRep ( PrimRep(..) )
import StgSyn ( StgArg, GenStgArg(..) )
...
...
ghc/compiler/codeGen/CgUpdate.lhs
View file @
084c8a02
...
...
@@ -11,10 +11,8 @@ module CgUpdate ( pushUpdateFrame, reserveSeqFrame, pushSeqFrame ) where
import CgMonad
import AbsCSyn
import PrimRep ( PrimRep(..) )
import CgStackery ( allocStackTop, updateFrameSize, seqFrameSize )
import CgUsages ( getVirtSp, getSpRelOffset )
import CmdLineOpts ( opt_SccProfilingOn )
import Panic ( assertPanic )
\end{code}
...
...
ghc/compiler/codeGen/CodeGen.lhs
View file @
084c8a02
...
...
@@ -25,7 +25,7 @@ import AbsCSyn
import CLabel ( CLabel, mkSRTLabel, mkClosureLabel, mkModuleInitLabel )
import PprAbsC ( dumpRealC )
import AbsCUtils ( mkAbstractCs,
mkAbsCStmts,
flattenAbsC )
import AbsCUtils ( mkAbstractCs, flattenAbsC )
import CgBindery ( CgIdInfo, addBindC, addBindsC )
import CgClosure ( cgTopRhsClosure )
import CgCon ( cgTopRhsCon )
...
...
@@ -35,10 +35,9 @@ import CmdLineOpts ( opt_SccProfilingOn, opt_EnsureSplittableC,
opt_D_dump_absC
)
import CostCentre ( CostCentre, CostCentreStack )
import FiniteMap ( FiniteMap )
import Id ( Id, idName )
import Module ( Module, moduleString, moduleName,
ModuleName
, moduleNameString
)
ModuleName )
import PrimRep ( getPrimRepSize, PrimRep(..) )
import Type ( Type )
import TyCon ( TyCon, isDataTyCon )
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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