Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
jberryman
GHC
Commits
47eef4b5
Commit
47eef4b5
authored
Nov 06, 2000
by
simonpj
Browse files
[project @ 2000-11-06 08:15:20 by simonpj]
Dealing with instance-decl imports; and removing unnecessary imports
parent
cd241c73
Changes
39
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/Makefile
View file @
47eef4b5
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.10
8
2000/11/0
3 17:09:0
0 simon
mar
Exp $
# $Id: Makefile,v 1.10
9
2000/11/0
6 08:15:2
0 simon
pj
Exp $
TOP
=
..
include
$(TOP)/mk/boilerplate.mk
...
...
@@ -91,7 +91,7 @@ $(HS_PROG) :: $(HS_SRCS)
DIRS
=
\
utils basicTypes types hsSyn prelude rename typecheck deSugar coreSyn
\
specialise simplCore stranal stgSyn simplStg codeGen absCSyn main
\
profiling parser usageSP cprAnalysis javaGen compMan
profiling parser usageSP cprAnalysis javaGen compMan
ghci
ifeq
($(GhcWithNativeCodeGen),YES)
DIRS
+=
nativeGen
...
...
ghc/compiler/absCSyn/AbsCUtils.lhs
View file @
47eef4b5
...
...
@@ -419,8 +419,6 @@ We use the strongly-connected component algorithm, in which
type CVertex = (Int, AbstractC) -- Give each vertex a unique number,
-- for fast comparison
type CEdge = (CVertex, CVertex)
doSimultaneously abs_c
= let
enlisted = en_list abs_c
...
...
ghc/compiler/absCSyn/CLabel.lhs
View file @
47eef4b5
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CLabel.lhs,v 1.4
0
2000/1
0/16 13:57:43 seward
j Exp $
% $Id: CLabel.lhs,v 1.4
1
2000/1
1/06 08:15:20 simonp
j Exp $
%
\section[CLabel]{@CLabel@: Information to make C Labels}
...
...
@@ -83,15 +83,14 @@ import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
import CmdLineOpts ( opt_Static, opt_DoTickyProfiling )
import CStrings ( pp_cSEP )
import DataCon ( ConTag
, DataCon
)
import Module (
ModuleName,
moduleName, moduleNameFS,
import DataCon ( ConTag )
import Module ( moduleName, moduleNameFS,
Module, isModuleInThisPackage )
import Name ( Name, getName, isDllName, isExternallyVisibleName )
import TyCon ( TyCon )
import Unique ( pprUnique, Unique )
import PrimOp ( PrimOp, pprPrimOp )
import CostCentre ( CostCentre, CostCentreStack )
import Util
import Outputable
\end{code}
...
...
ghc/compiler/absCSyn/PprAbsC.lhs
View file @
47eef4b5
...
...
@@ -43,7 +43,7 @@ import FiniteMap ( addToFM, emptyFM, lookupFM, FiniteMap )
import Literal ( Literal(..) )
import TyCon ( tyConDataCons )
import Name ( NamedThing(..) )
import DataCon (
DataCon{-instance NamedThing-},
dataConWrapId )
import DataCon ( dataConWrapId )
import Maybes ( maybeToBool, catMaybes )
import PrimOp ( primOpNeedsWrapper, pprPrimOp, pprCCallOp,
PrimOp(..), CCall(..), CCallTarget(..), isDynamicTarget )
...
...
@@ -60,7 +60,6 @@ import GlaExts
import Util ( nOfThem )
import ST
import MutableArray
infixr 9 `thenTE`
\end{code}
...
...
@@ -648,9 +647,6 @@ pp_basic_restores = ptext SLIT("CALLER_RESTORE_SYSTEM")
\end{code}
\begin{code}
has_srt (_, NoSRT) = False
has_srt _ = True
pp_srt_info srt =
case srt of
(lbl, NoSRT) ->
...
...
ghc/compiler/codeGen/CgBindery.lhs
View file @
47eef4b5
...
...
@@ -38,7 +38,6 @@ import CLabel ( mkClosureLabel,
import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
import BitSet ( mkBS, emptyBS )
import PrimRep ( isFollowableRep, getPrimRepSize )
import DataCon ( DataCon, dataConName )
import Id ( Id, idPrimRep, idType, isDataConWrapId )
import Type ( typePrimRep )
import VarEnv
...
...
@@ -398,11 +397,6 @@ bindNewToReg name magic_id lf_info
where
info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info
bindNewToLit name lit
= addBindC name info
where
info = MkCgIdInfo name NoVolatileLoc (LitLoc lit) (error "bindNewToLit")
bindArgsToRegs :: [Id] -> [MagicId] -> Code
bindArgsToRegs args regs
= listCs (zipWithEqual "bindArgsToRegs" bind args regs)
...
...
ghc/compiler/codeGen/CgClosure.lhs
View file @
47eef4b5
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.4
2
2000/1
0/24 08:40:09
simonpj Exp $
% $Id: CgClosure.lhs,v 1.4
3
2000/1
1/06 08:15:21
simonpj Exp $
%
\section[CgClosure]{Code generation for closures}
...
...
@@ -58,8 +58,6 @@ import Outputable
import Name ( nameOccName )
import OccName ( occNameFS )
import FastTypes ( iBox )
getWrapperArgTypeCategories = panic "CgClosure.getWrapperArgTypeCategories (ToDo)"
\end{code}
%********************************************************
...
...
@@ -745,43 +743,3 @@ chooseDynCostCentres ccs args fvs body
========================================================================
OLD CODE THAT EMITTED INFORMATON FOR QUANTITATIVE ANALYSIS
It's pretty wierd, so I've nuked it for now. SLPJ Nov 96
\begin{pseudocode}
getWrapperArgTypeCategories
:: Type -- wrapper's type
-> StrictnessInfo bdee -- strictness info about its args
-> Maybe String
getWrapperArgTypeCategories _ NoStrictnessInfo = Nothing
getWrapperArgTypeCategories _ BottomGuaranteed
= trace "getWrapperArgTypeCategories:BottomGuaranteed!" Nothing -- wrong
getWrapperArgTypeCategories _ (StrictnessInfo [] _) = Nothing
getWrapperArgTypeCategories ty (StrictnessInfo arg_info _)
= Just (mkWrapperArgTypeCategories ty arg_info)
mkWrapperArgTypeCategories
:: Type -- wrapper's type
-> [Demand] -- info about its arguments
-> String -- a string saying lots about the args
mkWrapperArgTypeCategories wrapper_ty wrap_info
= case (splitFunTy_maybe wrapper_ty) of { Just (arg_tys,_) ->
map do_one (wrap_info `zip` (map showTypeCategory arg_tys)) }
where
-- ToDo: this needs FIXING UP (it was a hack anyway...)
do_one (WwPrim, _) = 'P'
do_one (WwEnum, _) = 'E'
do_one (WwStrict, arg_ty_char) = arg_ty_char
do_one (WwUnpack _ _ _, arg_ty_char)
= if arg_ty_char `elem` "CIJFDTS"
then toLower arg_ty_char
else if arg_ty_char == '+' then 't'
else trace ("mkWrapp..:funny char:"++[arg_ty_char]) '-'
do_one (other_wrap_info, _) = '-'
\end{pseudocode}
ghc/compiler/codeGen/CgConTbls.lhs
View file @
47eef4b5
...
...
@@ -17,11 +17,9 @@ import CLabel ( mkConEntryLabel )
import ClosureInfo ( layOutStaticClosure, layOutDynCon,
mkConLFInfo, ClosureInfo
)
import CostCentre ( dontCareCCS )
import DataCon ( DataCon, dataConName, dataConRepArgTys, isNullaryDataCon )
import Name ( getOccName )
import OccName ( occNameUserString )
import PrimRep ( getPrimRepSize, PrimRep(..) )
import TyCon ( tyConDataCons, isEnumerationTyCon, TyCon )
import Type ( typePrimRep )
\end{code}
...
...
@@ -140,7 +138,6 @@ genConInfo comp_info tycon data_con
-- just one more thing to go wrong.
arg_tys = dataConRepArgTys data_con
entry_label = mkConEntryLabel con_name
con_name = dataConName data_con
\end{code}
...
...
ghc/compiler/codeGen/CgHeapery.lhs
View file @
47eef4b5
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgHeapery.lhs,v 1.2
4
2000/1
0/24 08:40:10
simonpj Exp $
% $Id: CgHeapery.lhs,v 1.2
5
2000/1
1/06 08:15:21
simonpj Exp $
%
\section[CgHeapery]{Heap management functions}
...
...
@@ -26,8 +26,7 @@ import CgUsages ( getVirtAndRealHp, getRealSp, setVirtHp, setRealHp,
initHeapUsage
)
import ClosureInfo ( closureSize, closureGoodStuffSize,
slopSize, allocProfilingMsg, ClosureInfo,
closureSMRep
slopSize, allocProfilingMsg, ClosureInfo
)
import PrimRep ( PrimRep(..), isFollowableRep )
import Unique ( Unique )
...
...
ghc/compiler/codeGen/CgMonad.lhs
View file @
47eef4b5
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgMonad.lhs,v 1.2
5
2000/
09/04 14:07
:2
9
simon
mar
Exp $
% $Id: CgMonad.lhs,v 1.2
6
2000/
11/06 08:15
:2
1
simon
pj
Exp $
%
\section[CgMonad]{The code generation monad}
...
...
@@ -42,7 +42,7 @@ module CgMonad (
#include "HsVersions.h"
import {-# SOURCE #-} CgBindery (
CgIdInfo,
CgBindings, nukeVolatileBinds )
import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
import {-# SOURCE #-} CgUsages ( getSpRelOffset )
import AbsCSyn
...
...
ghc/compiler/codeGen/CgTailCall.lhs
View file @
47eef4b5
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgTailCall.lhs,v 1.2
7
2000/1
0
/0
3
08:
43:00
simonpj Exp $
% $Id: CgTailCall.lhs,v 1.2
8
2000/1
1
/0
6
08:
15:21
simonpj Exp $
%
%********************************************************
%* *
...
...
@@ -50,13 +50,12 @@ import Id ( Id, idType, idName )
import DataCon ( DataCon, dataConTyCon, dataConTag, fIRST_TAG )
import Maybes ( maybeToBool )
import PrimRep ( PrimRep(..) )
import StgSyn ( StgArg
, GenStgArg(..)
)
import StgSyn ( StgArg )
import Type ( isUnLiftedType )
import TyCon ( TyCon )
import PrimOp ( PrimOp )
import Util ( zipWithEqual )
import ListSetOps ( assocMaybe )
import Unique ( mkPseudoUnique1 )
import Outputable
import Panic ( panic, assertPanic )
\end{code}
...
...
ghc/compiler/main/HscMain.lhs
View file @
47eef4b5
...
...
@@ -380,9 +380,9 @@ initPersistentRenamerState :: IO PersistentRenamerState
return (
PRS { prsOrig = Orig { origNames = initOrigNames,
origIParam = emptyFM },
prsDecls = emptyNameEnv,
prsInsts = emptyBag,
prsRules = emptyBag,
prsDecls =
(
emptyNameEnv,
0),
prsInsts =
(
emptyBag,
0),
prsRules =
(
emptyBag,
0),
prsNS = ns
}
)
...
...
ghc/compiler/main/HscTypes.lhs
View file @
47eef4b5
...
...
@@ -48,7 +48,6 @@ import RdrName ( RdrNameEnv, emptyRdrEnv )
import Name ( Name, NamedThing, isLocallyDefined,
getName, nameModule, nameSrcLoc )
import Name -- Env
import NameSet ( NameSet )
import OccName ( OccName )
import Module ( Module, ModuleName, ModuleEnv,
lookupModuleEnv, lookupModuleEnvByName, emptyModuleEnv
...
...
@@ -62,7 +61,7 @@ import TyCon ( TyCon )
import BasicTypes ( Version, initialVersion, Fixity )
import HsSyn ( DeprecTxt )
import RdrHsSyn ( RdrName
Hs
Decl, RdrNameTyClDecl )
import RdrHsSyn ( RdrName
InstDecl, RdrNameRule
Decl, RdrNameTyClDecl )
import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
import CoreSyn ( IdCoreRule )
...
...
@@ -471,12 +470,14 @@ including the constructors of a type decl etc. The Bool is True just
for the 'main' Name.
\begin{code}
type DeclsMap = NameEnv (AvailInfo, Bool, (Module, RdrNameTyClDecl))
type DeclsMap = (NameEnv (AvailInfo, Bool, (Module, RdrNameTyClDecl)), Int)
-- The Int says how many have been sucked in
type IfaceInsts =
Bag
GatedDecl
type IfaceRules =
Bag
GatedDecl
type IfaceInsts = GatedDecl
s RdrNameInstDecl
type IfaceRules = GatedDecl
s RdrNameRuleDecl
type GatedDecl = ([Name], (Module, RdrNameHsDecl))
type GatedDecls d = (Bag (GatedDecl d), Int) -- The Int says how many have been sucked in
type GatedDecl d = ([Name], (Module, d))
\end{code}
...
...
ghc/compiler/nativeGen/AbsCStixGen.lhs
View file @
47eef4b5
...
...
@@ -24,8 +24,7 @@ import SMRep ( fixedItblSize,
import Constants ( mIN_UPD_SIZE )
import CLabel ( CLabel, mkReturnInfoLabel, mkReturnPtLabel,
mkClosureTblLabel, mkClosureLabel,
moduleRegdLabel, labelDynamic,
mkSplitMarkerLabel )
labelDynamic, mkSplitMarkerLabel )
import ClosureInfo ( infoTableLabelFromCI, entryLabelFromCI,
fastLabelFromCI, closureUpdReqd,
staticClosureNeedsLink
...
...
@@ -45,7 +44,6 @@ import TyCon ( tyConDataCons )
import DataCon ( dataConWrapId )
import BitSet ( intBS )
import Name ( NamedThing(..) )
import Char ( ord )
import CmdLineOpts ( opt_Static, opt_EnsureSplittableC )
\end{code}
...
...
ghc/compiler/nativeGen/AsmCodeGen.lhs
View file @
47eef4b5
...
...
@@ -16,23 +16,23 @@ import MachCode
import PprMach
import AbsCStixGen ( genCodeAbstractC )
import AbsCSyn ( AbstractC
, MagicId
)
import AbsCSyn ( AbstractC )
import AbsCUtils ( mkAbsCStmtList )
import AsmRegAlloc ( runRegAllocate )
import PrimOp ( commutableOp, PrimOp(..) )
import RegAllocInfo ( findReservedRegs )
import Stix ( StixTree(..), StixReg(..),
pprStixTrees, pprStixTree,
CodeSegment(..),
pprStixTrees, pprStixTree,
stixCountTempUses, stixSubst,
NatM,
initNat, mapNat,
NatM_State,
mkNatM_State,
initNat, mapNat,
mkNatM_State,
uniqOfNatM_State, deltaOfNatM_State )
import UniqSupply ( returnUs, thenUs,
mapUs,
initUs,
initUs_,
UniqSM, UniqSupply,
lazyThenUs,
lazyMapUs )
import UniqSupply ( returnUs, thenUs, initUs,
UniqSM, UniqSupply,
lazyMapUs )
import MachMisc ( IF_ARCH_i386(i386_insert_ffrees,) )
import OrdList (
fromOL,
concatOL )
import OrdList ( concatOL )
import Outputable
\end{code}
...
...
ghc/compiler/nativeGen/AsmRegAlloc.lhs
View file @
47eef4b5
...
...
@@ -14,11 +14,10 @@ import PprMach ( pprInstr ) -- Just for debugging
import MachRegs
import RegAllocInfo
import FiniteMap ( FiniteMap, emptyFM, addListToFM, delListFromFM,
lookupFM, keysFM, eltsFM, mapFM, addToFM_C, addToFM,
listToFM, fmToList, lookupWithDefaultFM )
import Unique ( mkBuiltinUnique )
import OrdList ( unitOL, appOL, fromOL, concatOL )
import FiniteMap ( FiniteMap, emptyFM,
lookupFM, eltsFM, addToFM_C, addToFM,
listToFM, fmToList )
import OrdList ( fromOL )
import Outputable
import Unique ( Unique, Uniquable(..), mkPseudoUnique3 )
import CLabel ( CLabel, pprCLabel )
...
...
ghc/compiler/nativeGen/PprMach.lhs
View file @
47eef4b5
...
...
@@ -18,8 +18,7 @@ import MachRegs -- may differ per-platform
import MachMisc
import CLabel ( pprCLabel_asm, externallyVisibleCLabel, labelDynamic )
import Stix ( CodeSegment(..), StixTree(..) )
import Char ( isPrint, isDigit )
import Stix ( CodeSegment(..) )
import Outputable
import ST
...
...
ghc/compiler/nativeGen/RegAllocInfo.lhs
View file @
47eef4b5
...
...
@@ -36,11 +36,11 @@ module RegAllocInfo (
#include "HsVersions.h"
import List (
partition,
sort )
import List ( sort )
import MachMisc
import MachRegs
import Stix ( DestInfo(..) )
import CLabel (
pprCLabel_asm,
isAsmTemp, CLabel{-instance Ord-} )
import CLabel ( isAsmTemp, CLabel{-instance Ord-} )
import FiniteMap ( addToFM, lookupFM, FiniteMap )
import Outputable
import Constants ( rESERVED_C_STACK_BYTES )
...
...
ghc/compiler/nativeGen/Stix.lhs
View file @
47eef4b5
...
...
@@ -30,7 +30,7 @@ import Ratio ( Rational )
import AbsCSyn ( node, tagreg, MagicId(..) )
import CallConv ( CallConv, pprCallConv )
import CLabel ( mkAsmTempLabel, CLabel, pprCLabel
, pprCLabel_asm
)
import CLabel ( mkAsmTempLabel, CLabel, pprCLabel )
import PrimRep ( PrimRep(..), showPrimRep )
import PrimOp ( PrimOp, pprPrimOp )
import Unique ( Unique )
...
...
ghc/compiler/nativeGen/StixInfo.lhs
View file @
47eef4b5
...
...
@@ -17,7 +17,7 @@ import ClosureInfo ( closurePtrsSize,
infoTblNeedsSRT, getSRTInfo, closureSemiTag
)
import PrimRep ( PrimRep(..) )
import SMRep (
SMRep(..),
getSMRepClosureTypeInt )
import SMRep ( getSMRepClosureTypeInt )
import Stix -- all of it
import UniqSupply ( returnUs, UniqSM )
import BitSet ( intBS )
...
...
ghc/compiler/nativeGen/StixInteger.lhs
View file @
47eef4b5
...
...
@@ -14,17 +14,13 @@ module StixInteger (
#include "HsVersions.h"
import {-# SOURCE #-} StixPrim ( amodeToStix )
import MachMisc
import MachRegs
import AbsCSyn hiding (spRel) -- bits and bobs..
import Literal ( Literal(..) )
import CallConv ( cCallConv )
import PrimOp ( PrimOp(..) )
import PrimRep ( PrimRep(..) )
import SMRep ( arrWordsHdrSize )
import Stix ( StixTree(..), StixTreeList, arrWordsHS )
import UniqSupply ( returnUs,
thenUs,
UniqSM )
import UniqSupply ( returnUs, UniqSM )
\end{code}
Although gmpCompare doesn't allocate space, it does temporarily use
...
...
Prev
1
2
Next
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