[project @ 1999-06-09 14:28:37 by simonmar]

Move some code around to reduce the linkage between CgMonad and CgBindery,
and make the .hi-boot-5 file compatible with both 4.02 and 4.03.

diff --git a/ghc/compiler/codeGen/CgBindery.hi-boot b/ghc/compiler/codeGen/CgBindery.hi-boot
index 2cc7a1c..f80decb 100644 (file)
--- 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 441dace..9a4ba58 100644 (file)
--- 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 5486201..f375fcc 100644 (file)
--- 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 8fe334e..3481fea 100644 (file)
--- 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 )
@@ -165,6 +165,63 @@ idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode:
 
 %************************************************************************
 %*                                                                     *
+\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 a57ee94..fc96eb3 100644 (file)
--- 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 df41f44..d649bc2 100644 (file)
--- 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 35e18cb..95926aa 100644 (file)
--- 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 )