diff --git a/ghc/compiler/codeGen/CgBindery.hi-boot b/ghc/compiler/codeGen/CgBindery.hi-boot
index 2cc7a1c20b6e6cafbf1731b6a7c180135aa0cc55..f80decba35d26ba1eccd561542502f59893b7e73 100644
--- a/ghc/compiler/codeGen/CgBindery.hi-boot
+++ b/ghc/compiler/codeGen/CgBindery.hi-boot
@@ -1,10 +1,9 @@
_interface_ CgBindery 1
_exports_
-CgBindery CgBindings CgIdInfo(MkCgIdInfo) VolatileLoc StableLoc nukeVolatileBinds maybeStkLoc;
+CgBindery CgBindings CgIdInfo VolatileLoc StableLoc nukeVolatileBinds;
_declarations_
1 type CgBindings = VarEnv.IdEnv CgIdInfo;
-1 data CgIdInfo = MkCgIdInfo Var.Id VolatileLoc StableLoc ClosureInfo!LambdaFormInfo;
+1 data CgIdInfo;
1 data VolatileLoc;
1 data StableLoc;
1 nukeVolatileBinds _:_ CgBindings -> CgBindings ;;
-1 maybeStkLoc _:_ StableLoc -> PrelMaybe.Maybe AbsCSyn.VirtualSpOffset ;;
diff --git a/ghc/compiler/codeGen/CgBindery.hi-boot-4 b/ghc/compiler/codeGen/CgBindery.hi-boot-4
index 441dace2fd2fea1a44515c1f540d8bd76a15533a..9a4ba58313411c8f7c56da4208ec01d33ad43abb 100644
--- a/ghc/compiler/codeGen/CgBindery.hi-boot-4
+++ b/ghc/compiler/codeGen/CgBindery.hi-boot-4
@@ -1,10 +1,9 @@
_interface_ CgBindery 1 0
_exports_
-CgBindery CgBindings CgIdInfo{MkCgIdInfo} VolatileLoc StableLoc nukeVolatileBinds maybeStkLoc;
+CgBindery CgBindings CgIdInfo VolatileLoc StableLoc nukeVolatileBinds;
_declarations_
1 type CgBindings = VarEnv.IdEnv CgIdInfo;
-1 data CgIdInfo = MkCgIdInfo Var.Id VolatileLoc StableLoc ClosureInfo!LambdaFormInfo;
+1 data CgIdInfo;
1 data VolatileLoc;
1 data StableLoc;
1 nukeVolatileBinds _:_ CgBindings -> CgBindings ;;
-1 maybeStkLoc _:_ StableLoc -> PrelMaybe.Maybe AbsCSyn.VirtualSpOffset ;;
diff --git a/ghc/compiler/codeGen/CgBindery.hi-boot-5 b/ghc/compiler/codeGen/CgBindery.hi-boot-5
index 548620193749bff382b9a9a64f89a266093eea9f..f375fcc6e147df8375250d16df082932d6dc5c6f 100644
--- a/ghc/compiler/codeGen/CgBindery.hi-boot-5
+++ b/ghc/compiler/codeGen/CgBindery.hi-boot-5
@@ -1,8 +1,7 @@
__interface CgBindery 1 0 where
-__export CgBindery CgBindings CgIdInfo{MkCgIdInfo} VolatileLoc StableLoc nukeVolatileBinds maybeStkLoc;
+__export CgBindery CgBindings CgIdInfo VolatileLoc StableLoc nukeVolatileBinds;
1 type CgBindings = VarEnv.IdEnv CgIdInfo;
-1 data CgIdInfo = MkCgIdInfo Var.Id VolatileLoc StableLoc ClosureInfo!LambdaFormInfo;
+1 data CgIdInfo;
1 data VolatileLoc;
1 data StableLoc;
1 nukeVolatileBinds :: CgBindings -> CgBindings ;
-1 maybeStkLoc :: StableLoc -> PrelMaybe.Maybe AbsCSyn.VirtualSpOffset ;
diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs
index 8fe334e985a2e5994bcda4e7757cc20689bdf8b3..3481feadabd47e72f8e478c427c542d873f0d9ac 100644
--- a/ghc/compiler/codeGen/CgBindery.lhs
+++ b/ghc/compiler/codeGen/CgBindery.lhs
@@ -5,14 +5,14 @@
\begin{code}
module CgBindery (
- CgBindings, CgIdInfo(..){-dubiously concrete-},
+ CgBindings, CgIdInfo,
StableLoc, VolatileLoc,
- maybeStkLoc,
-
stableAmodeIdInfo, heapIdInfo, newTempAmodeAndIdInfo,
letNoEscapeIdInfo, idInfoToAmode,
+ addBindC, addBindsC,
+
nukeVolatileBinds,
nukeDeadBindings,
@@ -34,7 +34,7 @@ import CgMonad
import CgUsages ( getHpRelOffset, getSpRelOffset, getRealSp )
import CgStackery ( freeStackSlots, addFreeSlots )
import CLabel ( mkStaticClosureLabel, mkClosureLabel,
- mkBitmapLabel )
+ mkBitmapLabel, pprCLabel )
import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
import BitSet ( mkBS, emptyBS )
import PrimRep ( isFollowableRep, getPrimRepSize )
@@ -163,6 +163,63 @@ idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode:
#endif
\end{code}
+%************************************************************************
+%* *
+\subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
+%* *
+%************************************************************************
+
+There are three basic routines, for adding (@addBindC@), modifying
+(@modifyBindC@) and looking up (@lookupBindC@) bindings.
+
+A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
+The name should not already be bound. (nice ASSERT, eh?)
+
+\begin{code}
+addBindC :: Id -> CgIdInfo -> Code
+addBindC name stuff_to_bind info_down (MkCgState absC binds usage)
+ = MkCgState absC (extendVarEnv binds name stuff_to_bind) usage
+
+addBindsC :: [(Id, CgIdInfo)] -> Code
+addBindsC new_bindings info_down (MkCgState absC binds usage)
+ = MkCgState absC new_binds usage
+ where
+ new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
+ binds
+ new_bindings
+
+modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
+modifyBindC name mangle_fn info_down (MkCgState absC binds usage)
+ = MkCgState absC (modifyVarEnv mangle_fn binds name) usage
+
+lookupBindC :: Id -> FCode CgIdInfo
+lookupBindC name info_down@(MkCgInfoDown _ static_binds srt _)
+ state@(MkCgState absC local_binds usage)
+ = (val, state)
+ where
+ val = case (lookupVarEnv local_binds name) of
+ Nothing -> try_static
+ Just this -> this
+
+ try_static =
+ case (lookupVarEnv static_binds name) of
+ Just this -> this
+ Nothing
+ -> cgPanic (text "lookupBindC: no info for" <+> ppr name) info_down state
+
+cgPanic :: SDoc -> CgInfoDownwards -> CgState -> a
+cgPanic doc info_down@(MkCgInfoDown _ static_binds srt _)
+ state@(MkCgState absC local_binds usage)
+ = pprPanic "cgPanic"
+ (vcat [doc,
+ ptext SLIT("static binds for:"),
+ vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv static_binds ],
+ ptext SLIT("local binds for:"),
+ vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv local_binds ],
+ ptext SLIT("SRT label") <+> pprCLabel srt
+ ])
+\end{code}
+
%************************************************************************
%* *
\subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index a57ee94f42625152136c602966476efd35ff5fa3..fc96eb32da14db82a199bebb2f4d2b05324221fe 100644
--- a/ghc/compiler/codeGen/CgExpr.lhs
+++ b/ghc/compiler/codeGen/CgExpr.lhs
@@ -1,7 +1,7 @@
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgExpr.lhs,v 1.26 1999/06/08 15:56:47 simonmar Exp $
+% $Id: CgExpr.lhs,v 1.27 1999/06/09 14:28:38 simonmar Exp $
%
%********************************************************
%* *
@@ -22,7 +22,8 @@ import AbsCUtils ( mkAbstractCs )
import CLabel ( mkClosureTblLabel )
import SMRep ( fixedHdrSize )
-import CgBindery ( getArgAmodes, getArgAmode, CgIdInfo, nukeDeadBindings)
+import CgBindery ( getArgAmodes, getArgAmode, CgIdInfo,
+ nukeDeadBindings, addBindC, addBindsC )
import CgCase ( cgCase, saveVolatileVarsAndRegs,
restoreCurrentCostCentre )
import CgClosure ( cgRhsClosure, cgStdRhsClosure )
diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
index df41f44dba8b3327b37d35bee6daf9c276e14417..d649bc24aba61b414c3f9f06b3c8849dc0614106 100644
--- a/ghc/compiler/codeGen/CgMonad.lhs
+++ b/ghc/compiler/codeGen/CgMonad.lhs
@@ -1,7 +1,7 @@
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgMonad.lhs,v 1.21 1999/06/08 15:56:47 simonmar Exp $
+% $Id: CgMonad.lhs,v 1.22 1999/06/09 14:28:38 simonmar Exp $
%
\section[CgMonad]{The code generation monad}
@@ -20,8 +20,6 @@ module CgMonad (
forkEvalHelp, forkAbsC,
SemiTaggingStuff,
- addBindC, addBindsC, modifyBindC, lookupBindC,
-
EndOfBlockInfo(..),
setEndOfBlockInfo, getEndOfBlockInfo,
@@ -29,7 +27,7 @@ module CgMonad (
StackUsage, Slot(..), HeapUsage,
- profCtrC, cgPanic,
+ profCtrC,
costCentresC, moduleName,
@@ -43,13 +41,13 @@ module CgMonad (
#include "HsVersions.h"
-import {-# SOURCE #-} CgBindery ( CgIdInfo(..), CgBindings, maybeStkLoc, nukeVolatileBinds )
+import {-# SOURCE #-} CgBindery ( CgIdInfo, CgBindings, nukeVolatileBinds )
import {-# SOURCE #-} CgUsages ( getSpRelOffset )
import AbsCSyn
import AbsCUtils ( mkAbsCStmts )
import CmdLineOpts ( opt_SccProfilingOn, opt_DoTickyProfiling )
-import CLabel ( CLabel, mkUpdInfoLabel, pprCLabel )
+import CLabel ( CLabel, mkUpdInfoLabel )
import Module ( Module )
import DataCon ( ConTag )
import Id ( Id )
@@ -177,12 +175,18 @@ sequelToAmode (OnStack virt_sp_offset)
sequelToAmode UpdateCode = returnFC (CLbl mkUpdInfoLabel RetRep)
sequelToAmode (CaseAlts amode _) = returnFC amode
-sequelToAmode (SeqFrame _ _) = cgPanic (text "sequelToAmode: SeqFrame")
+sequelToAmode (SeqFrame _ _) = panic "sequelToAmode: SeqFrame"
type CgStksAndHeapUsage -- stacks and heap usage information
= (StackUsage, HeapUsage)
-data Slot = Free | NonPointer deriving (Eq,Show)
+data Slot = Free | NonPointer
+ deriving
+#ifdef DEBUG
+ (Eq,Show)
+#else
+ Eq
+#endif
type StackUsage =
(Int, -- virtSp: Virtual offset of topmost allocated slot
@@ -564,60 +568,3 @@ setSRTLabel :: CLabel -> Code -> Code
setSRTLabel srt code (MkCgInfoDown c_info statics _ eob_info) state
= code (MkCgInfoDown c_info statics srt eob_info) state
\end{code}
-
-%************************************************************************
-%* *
-\subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
-%* *
-%************************************************************************
-
-There are three basic routines, for adding (@addBindC@), modifying
-(@modifyBindC@) and looking up (@lookupBindC@) bindings.
-
-A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
-The name should not already be bound. (nice ASSERT, eh?)
-
-\begin{code}
-addBindC :: Id -> CgIdInfo -> Code
-addBindC name stuff_to_bind info_down (MkCgState absC binds usage)
- = MkCgState absC (extendVarEnv binds name stuff_to_bind) usage
-
-addBindsC :: [(Id, CgIdInfo)] -> Code
-addBindsC new_bindings info_down (MkCgState absC binds usage)
- = MkCgState absC new_binds usage
- where
- new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
- binds
- new_bindings
-
-modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
-modifyBindC name mangle_fn info_down (MkCgState absC binds usage)
- = MkCgState absC (modifyVarEnv mangle_fn binds name) usage
-
-lookupBindC :: Id -> FCode CgIdInfo
-lookupBindC name info_down@(MkCgInfoDown _ static_binds srt _)
- state@(MkCgState absC local_binds usage)
- = (val, state)
- where
- val = case (lookupVarEnv local_binds name) of
- Nothing -> try_static
- Just this -> this
-
- try_static =
- case (lookupVarEnv static_binds name) of
- Just this -> this
- Nothing
- -> cgPanic (text "lookupBindC: no info for" <+> ppr name) info_down state
-
-cgPanic :: SDoc -> CgInfoDownwards -> CgState -> a
-cgPanic doc info_down@(MkCgInfoDown _ static_binds srt _)
- state@(MkCgState absC local_binds usage)
- = pprPanic "cgPanic"
- (vcat [doc,
- ptext SLIT("static binds for:"),
- vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv static_binds ],
- ptext SLIT("local binds for:"),
- vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv local_binds ],
- ptext SLIT("SRT label") <+> pprCLabel srt
- ])
-\end{code}
diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 35e18cb659ccc7ec35e9cb27f5bc296538ac3624..95926aa602bcbbab56e62ab9710df8fe85820b3b 100644
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -26,7 +26,7 @@ import CLabel ( CLabel, mkSRTLabel, mkClosureLabel )
import PprAbsC ( dumpRealC )
import AbsCUtils ( mkAbstractCs, mkAbsCStmts, flattenAbsC )
-import CgBindery ( CgIdInfo )
+import CgBindery ( CgIdInfo, addBindC, addBindsC )
import CgClosure ( cgTopRhsClosure )
import CgCon ( cgTopRhsCon )
import CgConTbls ( genStaticConBits )