_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 ;;
_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 ;;
__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 ;
\begin{code}
module CgBindery (
- CgBindings, CgIdInfo(..){-dubiously concrete-},
+ CgBindings, CgIdInfo,
StableLoc, VolatileLoc,
- maybeStkLoc,
-
stableAmodeIdInfo, heapIdInfo, newTempAmodeAndIdInfo,
letNoEscapeIdInfo, idInfoToAmode,
+ addBindC, addBindsC,
+
nukeVolatileBinds,
nukeDeadBindings,
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 )
%************************************************************************
%* *
+\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}
%* *
%************************************************************************
%
% (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 $
%
%********************************************************
%* *
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 )
%
% (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}
forkEvalHelp, forkAbsC,
SemiTaggingStuff,
- addBindC, addBindsC, modifyBindC, lookupBindC,
-
EndOfBlockInfo(..),
setEndOfBlockInfo, getEndOfBlockInfo,
StackUsage, Slot(..), HeapUsage,
- profCtrC, cgPanic,
+ profCtrC,
costCentresC, moduleName,
#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 )
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
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}
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 )