Commit 9d4c0380 authored by partain's avatar partain
Browse files

[project @ 1996-06-30 15:56:44 by partain]

partain 1.3 changes through 960629
parent da3d8948
...@@ -611,7 +611,7 @@ compile(reader/PrefixToHs,lhs,) ...@@ -611,7 +611,7 @@ compile(reader/PrefixToHs,lhs,)
compile(reader/ReadPrefix,lhs,if_ghc(-fvia-C -I$(COMPINFO_DIR) -Iparser '-#include"hspincl.h"')) compile(reader/ReadPrefix,lhs,if_ghc(-fvia-C -I$(COMPINFO_DIR) -Iparser '-#include"hspincl.h"'))
compile(reader/RdrHsSyn,lhs,) compile(reader/RdrHsSyn,lhs,)
compile(rename/ParseIface,hs,) compile(rename/ParseIface,hs,-Onot) /* sigh */
compile(rename/ParseUtils,lhs,) compile(rename/ParseUtils,lhs,)
compile(rename/RnHsSyn,lhs,) compile(rename/RnHsSyn,lhs,)
compile(rename/RnMonad,lhs,if_ghc(-fvia-C)) compile(rename/RnMonad,lhs,if_ghc(-fvia-C))
......
...@@ -5,4 +5,17 @@ MachMisc fixedHdrSizeInWords (..) ...@@ -5,4 +5,17 @@ MachMisc fixedHdrSizeInWords (..)
MachMisc varHdrSizeInWords (..) MachMisc varHdrSizeInWords (..)
CgRetConv ctrlReturnConvAlg (..) CgRetConv ctrlReturnConvAlg (..)
CgRetConv CtrlReturnConvention(..) CgRetConv CtrlReturnConvention(..)
ClosureInfo closureKind (..)
ClosureInfo closureLabelFromCI (..)
ClosureInfo closureNonHdrSize (..)
ClosureInfo closurePtrsSize (..)
ClosureInfo closureSMRep (..)
ClosureInfo closureSemiTag (..)
ClosureInfo closureSizeWithoutFixedHdr (..)
ClosureInfo closureTypeDescr (..)
ClosureInfo closureUpdReqd (..)
ClosureInfo infoTableLabelFromCI (..)
ClosureInfo maybeSelectorInfo (..)
ClosureInfo entryLabelFromCI (..)
ClosureInfo fastLabelFromCI (..)
\end{code} \end{code}
...@@ -20,6 +20,9 @@ module PprAbsC ( ...@@ -20,6 +20,9 @@ module PprAbsC (
IMP_Ubiq(){-uitous-} IMP_Ubiq(){-uitous-}
IMPORT_DELOOPER(AbsCLoop) -- break its dependence on ClosureInfo IMPORT_DELOOPER(AbsCLoop) -- break its dependence on ClosureInfo
IMPORT_1_3(IO(Handle))
IMPORT_1_3(Char(isDigit,isPrint))
IMPORT_1_3(GHCbase(Addr(..)) ) -- to see innards
import AbsCSyn import AbsCSyn
...@@ -35,7 +38,7 @@ import CmdLineOpts ( opt_SccProfilingOn ) ...@@ -35,7 +38,7 @@ import CmdLineOpts ( opt_SccProfilingOn )
import CostCentre ( uppCostCentre, uppCostCentreDecl ) import CostCentre ( uppCostCentre, uppCostCentreDecl )
import Costs ( costs, addrModeCosts, CostRes(..), Side(..) ) import Costs ( costs, addrModeCosts, CostRes(..), Side(..) )
import CStrings ( stringToC ) import CStrings ( stringToC )
import FiniteMap ( addToFM, emptyFM, lookupFM ) import FiniteMap ( addToFM, emptyFM, lookupFM, FiniteMap )
import HeapOffs ( isZeroOff, subOff, pprHeapOffset ) import HeapOffs ( isZeroOff, subOff, pprHeapOffset )
import Literal ( showLiteral, Literal(..) ) import Literal ( showLiteral, Literal(..) )
import Maybes ( maybeToBool, catMaybes ) import Maybes ( maybeToBool, catMaybes )
...@@ -799,7 +802,11 @@ process_casm results args string = process results args string ...@@ -799,7 +802,11 @@ process_casm results args string = process results args string
_ -> panic ("process_casm: casm with many results while processing _casm_ \"" ++ string ++ "\".\n") _ -> panic ("process_casm: casm with many results while processing _casm_ \"" ++ string ++ "\".\n")
other -> other ->
case readDec other of let
read_int :: ReadS Int
read_int = reads
in
case (read_int other) of
[(num,css)] -> [(num,css)] ->
if 0 <= num && num < length args if 0 <= num && num < length args
then uppBeside (uppParens (args !! num)) then uppBeside (uppParens (args !! num))
......
...@@ -83,6 +83,7 @@ import PprStyle ( PprStyle(..) ) ...@@ -83,6 +83,7 @@ import PprStyle ( PprStyle(..) )
import Pretty import Pretty
import SrcLoc ( mkUnknownSrcLoc ) import SrcLoc ( mkUnknownSrcLoc )
import Type ( eqSimpleTy, splitFunTyExpandingDicts ) import Type ( eqSimpleTy, splitFunTyExpandingDicts )
import Unique ( pprUnique )
import Util ( mapAccumL, panic, assertPanic, pprPanic ) import Util ( mapAccumL, panic, assertPanic, pprPanic )
#ifdef REALLY_HASKELL_1_3 #ifdef REALLY_HASKELL_1_3
...@@ -766,7 +767,7 @@ pp_unfolding sty for_this_id inline_env uf_details ...@@ -766,7 +767,7 @@ pp_unfolding sty for_this_id inline_env uf_details
pp NoUnfoldingDetails = pp_NONE pp NoUnfoldingDetails = pp_NONE
pp (MagicForm tag _) pp (MagicForm tag _)
= ppCat [ppPStr SLIT("_MF_"), ppPStr tag] = ppCat [ppPStr SLIT("_MF_"), pprUnique tag]
pp (GenForm _ _ BadUnfolding) = pp_NONE pp (GenForm _ _ BadUnfolding) = pp_NONE
......
...@@ -70,7 +70,7 @@ data UnfoldingDetails ...@@ -70,7 +70,7 @@ data UnfoldingDetails
| OtherLitForm [Literal] | OtherLitForm [Literal]
| OtherConForm [GenId (GenType (GenTyVar (GenUsage Unique)) Unique)] | OtherConForm [GenId (GenType (GenTyVar (GenUsage Unique)) Unique)]
| GenForm FormSummary (GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique), BinderInfo) (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenTyVar (GenUsage Unique)) Unique) UnfoldingGuidance | GenForm FormSummary (GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique), BinderInfo) (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenTyVar (GenUsage Unique)) Unique) UnfoldingGuidance
| MagicForm _PackedString MagicUnfoldingFun | MagicForm Unique MagicUnfoldingFun
data UnfoldingGuidance data UnfoldingGuidance
= UnfoldNever = UnfoldNever
......
...@@ -20,7 +20,7 @@ import PrelMods ( gHC_BUILTINS ) ...@@ -20,7 +20,7 @@ import PrelMods ( gHC_BUILTINS )
import PrimOp ( primOpInfo, tagOf_PrimOp, primOp_str, import PrimOp ( primOpInfo, tagOf_PrimOp, primOp_str,
PrimOpInfo(..), PrimOpResultInfo(..) ) PrimOpInfo(..), PrimOpResultInfo(..) )
import RnHsSyn ( RnName(..) ) import RnHsSyn ( RnName(..) )
import Type ( mkForAllTys, mkFunTys, mkTyVarTy, applyTyCon ) import Type ( mkForAllTys, mkFunTy, mkFunTys, mkTyVarTy, applyTyCon )
import TysWiredIn ( boolTy ) import TysWiredIn ( boolTy )
import Unique ( mkPrimOpIdUnique ) import Unique ( mkPrimOpIdUnique )
import Util ( panic ) import Util ( panic )
...@@ -44,7 +44,7 @@ primOpId op ...@@ -44,7 +44,7 @@ primOpId op
mk_prim_Id op str [] [ty,ty] (compare_fun_ty ty) 2 mk_prim_Id op str [] [ty,ty] (compare_fun_ty ty) 2
Coercing str ty1 ty2 -> Coercing str ty1 ty2 ->
mk_prim_Id op str [] [ty1] (mkFunTys [ty1] ty2) 1 mk_prim_Id op str [] [ty1] (ty1 `mkFunTy` ty2) 1
PrimResult str tyvars arg_tys prim_tycon kind res_tys -> PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
mk_prim_Id op str mk_prim_Id op str
...@@ -72,7 +72,7 @@ primOpId op ...@@ -72,7 +72,7 @@ primOpId op
\begin{code} \begin{code}
dyadic_fun_ty ty = mkFunTys [ty, ty] ty dyadic_fun_ty ty = mkFunTys [ty, ty] ty
monadic_fun_ty ty = mkFunTys [ty] ty monadic_fun_ty ty = ty `mkFunTy` ty
compare_fun_ty ty = mkFunTys [ty, ty] boolTy compare_fun_ty ty = mkFunTys [ty, ty] boolTy
\end{code} \end{code}
......
...@@ -132,7 +132,6 @@ module Unique ( ...@@ -132,7 +132,6 @@ module Unique (
parIdKey, parIdKey,
patErrorIdKey, patErrorIdKey,
primIoTyConKey, primIoTyConKey,
primIoDataConKey,
ratioDataConKey, ratioDataConKey,
ratioTyConKey, ratioTyConKey,
rationalTyConKey, rationalTyConKey,
...@@ -590,7 +589,6 @@ stateDataConKey = mkPreludeDataConUnique 39 ...@@ -590,7 +589,6 @@ stateDataConKey = mkPreludeDataConUnique 39
trueDataConKey = mkPreludeDataConUnique 40 trueDataConKey = mkPreludeDataConUnique 40
wordDataConKey = mkPreludeDataConUnique 41 wordDataConKey = mkPreludeDataConUnique 41
stDataConKey = mkPreludeDataConUnique 42 stDataConKey = mkPreludeDataConUnique 42
primIoDataConKey = mkPreludeDataConUnique 43
\end{code} \end{code}
%************************************************************************ %************************************************************************
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
#include "HsVersions.h" #include "HsVersions.h"
module CgBindery ( module CgBindery (
CgBindings(..), CgIdInfo(..){-dubiously concrete-}, SYN_IE(CgBindings), CgIdInfo(..){-dubiously concrete-},
StableLoc, VolatileLoc, StableLoc, VolatileLoc,
maybeAStkLoc, maybeBStkLoc, maybeAStkLoc, maybeBStkLoc,
...@@ -34,7 +34,7 @@ import CgMonad ...@@ -34,7 +34,7 @@ import CgMonad
import CgUsages ( getHpRelOffset, getSpARelOffset, getSpBRelOffset ) import CgUsages ( getHpRelOffset, getSpARelOffset, getSpBRelOffset )
import CLabel ( mkClosureLabel ) import CLabel ( mkClosureLabel )
import ClosureInfo ( mkLFImported, mkConLFInfo, mkLFArgument ) import ClosureInfo ( mkLFImported, mkConLFInfo, mkLFArgument, LambdaFormInfo )
import HeapOffs ( SYN_IE(VirtualHeapOffset), import HeapOffs ( SYN_IE(VirtualHeapOffset),
SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset) SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset)
) )
......
...@@ -63,8 +63,8 @@ import PrimRep ( getPrimRepSize, isFollowableRep, retPrimRepSize, ...@@ -63,8 +63,8 @@ import PrimRep ( getPrimRepSize, isFollowableRep, retPrimRepSize,
) )
import TyCon ( isEnumerationTyCon ) import TyCon ( isEnumerationTyCon )
import Type ( typePrimRep, import Type ( typePrimRep,
getAppSpecDataTyConExpandingDicts, maybeAppSpecDataTyConExpandingDicts, getAppSpecDataTyConExpandingDicts,
isEnumerationTyCon maybeAppSpecDataTyConExpandingDicts
) )
import Util ( sortLt, isIn, isn'tIn, zipEqual, import Util ( sortLt, isIn, isn'tIn, zipEqual,
pprError, panic, assertPanic pprError, panic, assertPanic
......
...@@ -24,15 +24,14 @@ import CgBindery ( getCAddrMode, getArgAmodes, ...@@ -24,15 +24,14 @@ import CgBindery ( getCAddrMode, getArgAmodes,
getCAddrModeAndInfo, bindNewToNode, getCAddrModeAndInfo, bindNewToNode,
bindNewToAStack, bindNewToBStack, bindNewToAStack, bindNewToBStack,
bindNewToReg, bindArgsToRegs, bindNewToReg, bindArgsToRegs,
stableAmodeIdInfo, heapIdInfo stableAmodeIdInfo, heapIdInfo, CgIdInfo
) )
import CgCompInfo ( spARelToInt, spBRelToInt ) import CgCompInfo ( spARelToInt, spBRelToInt )
import CgUpdate ( pushUpdateFrame ) import CgUpdate ( pushUpdateFrame )
import CgHeapery ( allocDynClosure, heapCheck import CgHeapery ( allocDynClosure, heapCheck
, heapCheckOnly, fetchAndReschedule, yield -- HWL , heapCheckOnly, fetchAndReschedule, yield -- HWL
) )
import CgRetConv ( mkLiveRegsMask, import CgRetConv ( ctrlReturnConvAlg, dataReturnConvAlg,
ctrlReturnConvAlg, dataReturnConvAlg,
CtrlReturnConvention(..), DataReturnConvention(..) CtrlReturnConvention(..), DataReturnConvention(..)
) )
import CgStackery ( getFinalStackHW, mkVirtStkOffsets, import CgStackery ( getFinalStackHW, mkVirtStkOffsets,
......
...@@ -26,7 +26,7 @@ import AbsCUtils ( mkAbstractCs, getAmodeRep ) ...@@ -26,7 +26,7 @@ import AbsCUtils ( mkAbstractCs, getAmodeRep )
import CgBindery ( getArgAmodes, bindNewToNode, import CgBindery ( getArgAmodes, bindNewToNode,
bindArgsToRegs, newTempAmodeAndIdInfo, bindArgsToRegs, newTempAmodeAndIdInfo,
idInfoToAmode, stableAmodeIdInfo, idInfoToAmode, stableAmodeIdInfo,
heapIdInfo heapIdInfo, CgIdInfo
) )
import CgClosure ( cgTopRhsClosure ) import CgClosure ( cgTopRhsClosure )
import CgCompInfo ( mAX_INTLIKE, mIN_INTLIKE ) import CgCompInfo ( mAX_INTLIKE, mIN_INTLIKE )
......
...@@ -16,8 +16,7 @@ import CgMonad ...@@ -16,8 +16,7 @@ import CgMonad
import AbsCUtils ( mkAbsCStmts, mkAbstractCs, magicIdPrimRep ) import AbsCUtils ( mkAbsCStmts, mkAbstractCs, magicIdPrimRep )
import CgCompInfo ( uF_UPDATEE ) import CgCompInfo ( uF_UPDATEE )
import CgHeapery ( heapCheck, allocDynClosure ) import CgHeapery ( heapCheck, allocDynClosure )
import CgRetConv ( mkLiveRegsMask, import CgRetConv ( dataReturnConvAlg, ctrlReturnConvAlg,
dataReturnConvAlg, ctrlReturnConvAlg,
CtrlReturnConvention(..), CtrlReturnConvention(..),
DataReturnConvention(..) DataReturnConvention(..)
) )
...@@ -33,7 +32,7 @@ import ClosureInfo ( layOutStaticClosure, layOutDynCon, ...@@ -33,7 +32,7 @@ import ClosureInfo ( layOutStaticClosure, layOutDynCon,
infoTableLabelFromCI, dataConLiveness infoTableLabelFromCI, dataConLiveness
) )
import CostCentre ( dontCareCostCentre ) import CostCentre ( dontCareCostCentre )
import FiniteMap ( fmToList ) import FiniteMap ( fmToList, FiniteMap )
import HeapOffs ( zeroOff, SYN_IE(VirtualHeapOffset) ) import HeapOffs ( zeroOff, SYN_IE(VirtualHeapOffset) )
import Id ( dataConTag, dataConRawArgTys, import Id ( dataConTag, dataConRawArgTys,
dataConNumFields, fIRST_TAG, dataConNumFields, fIRST_TAG,
......
...@@ -20,7 +20,7 @@ import CgMonad ...@@ -20,7 +20,7 @@ import CgMonad
import AbsCSyn import AbsCSyn
import AbsCUtils ( mkAbsCStmts, mkAbstractCs ) import AbsCUtils ( mkAbsCStmts, mkAbstractCs )
import CgBindery ( getArgAmodes ) import CgBindery ( getArgAmodes, CgIdInfo )
import CgCase ( cgCase, saveVolatileVarsAndRegs ) import CgCase ( cgCase, saveVolatileVarsAndRegs )
import CgClosure ( cgRhsClosure ) import CgClosure ( cgRhsClosure )
import CgCon ( buildDynCon, cgReturnDataCon ) import CgCon ( buildDynCon, cgReturnDataCon )
......
...@@ -20,7 +20,6 @@ import AbsCSyn ...@@ -20,7 +20,6 @@ import AbsCSyn
import CgMonad import CgMonad
import AbsCUtils ( mkAbstractCs, getAmodeRep ) import AbsCUtils ( mkAbstractCs, getAmodeRep )
import CgRetConv ( mkLiveRegsMask )
import CgUsages ( getVirtAndRealHp, setVirtHp, setRealHp, import CgUsages ( getVirtAndRealHp, setVirtHp, setRealHp,
initHeapUsage initHeapUsage
) )
......
...@@ -20,7 +20,8 @@ import CgMonad ...@@ -20,7 +20,8 @@ import CgMonad
import AbsCSyn import AbsCSyn
import CgBindery ( letNoEscapeIdInfo, bindArgsToRegs, import CgBindery ( letNoEscapeIdInfo, bindArgsToRegs,
bindNewToAStack, bindNewToBStack bindNewToAStack, bindNewToBStack,
CgIdInfo
) )
import CgHeapery ( heapCheck ) import CgHeapery ( heapCheck )
import CgRetConv ( assignRegs ) import CgRetConv ( assignRegs )
......
\begin{code} \begin{code}
interface CgLoop2_1_3 1 interface CgLoop2_1_3 1
__exports__ __exports__
Outputable Outputable (..) CgExpr cgExpr (..)
CgExpr getPrimOpArgAmodes (..)
\end{code} \end{code}
...@@ -34,7 +34,8 @@ import CgStackery ( adjustRealSps, mkStkAmodes ) ...@@ -34,7 +34,8 @@ import CgStackery ( adjustRealSps, mkStkAmodes )
import CgUsages ( getSpARelOffset ) import CgUsages ( getSpARelOffset )
import CLabel ( mkStdUpdCodePtrVecLabel, mkConUpdCodePtrVecLabel ) import CLabel ( mkStdUpdCodePtrVecLabel, mkConUpdCodePtrVecLabel )
import ClosureInfo ( nodeMustPointToIt, import ClosureInfo ( nodeMustPointToIt,
getEntryConvention, EntryConvention(..) getEntryConvention, EntryConvention(..),
LambdaFormInfo
) )
import CmdLineOpts ( opt_DoSemiTagging ) import CmdLineOpts ( opt_DoSemiTagging )
import HeapOffs ( zeroOff, SYN_IE(VirtualSpAOffset) ) import HeapOffs ( zeroOff, SYN_IE(VirtualSpAOffset) )
......
...@@ -27,6 +27,7 @@ import AbsCSyn ...@@ -27,6 +27,7 @@ import AbsCSyn
import AbsCUtils ( mkAbstractCs, mkAbsCStmts ) import AbsCUtils ( mkAbstractCs, mkAbsCStmts )
import Bag ( foldBag ) import Bag ( foldBag )
import CgBindery ( CgIdInfo )
import CgClosure ( cgTopRhsClosure ) import CgClosure ( cgTopRhsClosure )
import CgCon ( cgTopRhsCon ) import CgCon ( cgTopRhsCon )
import CgConTbls ( genStaticConBits ) import CgConTbls ( genStaticConBits )
...@@ -35,6 +36,7 @@ import CmdLineOpts ( opt_SccProfilingOn, opt_CompilingGhcInternals, ...@@ -35,6 +36,7 @@ import CmdLineOpts ( opt_SccProfilingOn, opt_CompilingGhcInternals,
opt_EnsureSplittableC, opt_SccGroup opt_EnsureSplittableC, opt_SccGroup
) )
import CStrings ( modnameToC ) import CStrings ( modnameToC )
import FiniteMap ( FiniteMap )
import Maybes ( maybeToBool ) import Maybes ( maybeToBool )
import PrimRep ( getPrimRepSize, PrimRep(..) ) import PrimRep ( getPrimRepSize, PrimRep(..) )
import Util ( panic, assertPanic ) import Util ( panic, assertPanic )
......
...@@ -50,7 +50,7 @@ import SrcLoc ( mkUnknownSrcLoc ) ...@@ -50,7 +50,7 @@ import SrcLoc ( mkUnknownSrcLoc )
import TyVar ( cloneTyVar, import TyVar ( cloneTyVar,
isNullTyVarEnv, addOneToTyVarEnv, SYN_IE(TyVarEnv) isNullTyVarEnv, addOneToTyVarEnv, SYN_IE(TyVarEnv)
) )
import Type ( mkFunTys, mkForAllTy, mkForAllUsageTy, mkTyVarTy, import Type ( mkFunTy, mkForAllTy, mkForAllUsageTy, mkTyVarTy,
getFunTy_maybe, applyTy, isPrimType, getFunTy_maybe, applyTy, isPrimType,
splitSigmaTy, splitFunTy, eqTy, applyTypeEnvToTy splitSigmaTy, splitFunTy, eqTy, applyTypeEnvToTy
) )
...@@ -91,7 +91,7 @@ coreExprType (Con con args) = applyTypeToArgs (idType con) args ...@@ -91,7 +91,7 @@ coreExprType (Con con args) = applyTypeToArgs (idType con) args
coreExprType (Prim op args) = applyTypeToArgs (primOpType op) args coreExprType (Prim op args) = applyTypeToArgs (primOpType op) args
coreExprType (Lam (ValBinder binder) expr) coreExprType (Lam (ValBinder binder) expr)
= mkFunTys [idType binder] (coreExprType expr) = idType binder `mkFunTy` coreExprType expr
coreExprType (Lam (TyBinder tyvar) expr) coreExprType (Lam (TyBinder tyvar) expr)
= mkForAllTy tyvar (coreExprType expr) = mkForAllTy tyvar (coreExprType expr)
......
...@@ -11,7 +11,7 @@ module Desugar ( deSugar, DsMatchContext, pprDsWarnings ) where ...@@ -11,7 +11,7 @@ module Desugar ( deSugar, DsMatchContext, pprDsWarnings ) where
IMP_Ubiq(){-uitous-} IMP_Ubiq(){-uitous-}
import HsSyn ( HsBinds, HsExpr ) import HsSyn ( HsBinds, HsExpr )
import TcHsSyn ( TypecheckedHsBinds(..), TypecheckedHsExpr(..) ) import TcHsSyn ( SYN_IE(TypecheckedHsBinds), SYN_IE(TypecheckedHsExpr) )
import CoreSyn import CoreSyn
import DsMonad import DsMonad
......
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