[project @ 1998-01-08 18:03:08 by simonm]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgMonad.lhs

diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
index 428d6f6..5f8e1d2 100644 (file)
--- a/ghc/compiler/codeGen/CgMonad.lhs
+++ b/ghc/compiler/codeGen/CgMonad.lhs
@@ -7,25 +7,23 @@ See the beginning of the top-level @CodeGen@ module, to see how this
 monadic stuff fits into the Big Picture.
 
 \begin{code}
-#include "HsVersions.h"
-
 module CgMonad (
-       Code(..),       -- type
-       FCode(..),      -- type
+       Code,   -- type
+       FCode,  -- type
 
        initC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs,
        returnFC, fixC, absC, nopC, getAbsC,
 
        forkClosureBody, forkStatics, forkAlts, forkEval,
        forkEvalHelp, forkAbsC,
-       SemiTaggingStuff(..),
+       SemiTaggingStuff,
 
        addBindC, addBindsC, modifyBindC, lookupBindC,
 
        EndOfBlockInfo(..),
        setEndOfBlockInfo, getEndOfBlockInfo,
 
-       AStackUsage(..), BStackUsage(..), HeapUsage(..),
+       AStackUsage, BStackUsage, HeapUsage,
        StubFlag,
        isStubbed,
 
@@ -47,8 +45,12 @@ module CgMonad (
        CompilationInfo(..)
     ) where
 
-import Ubiq{-uitous-}
-import CgLoop1         -- stuff from CgBindery and CgUsages
+#include "HsVersions.h"
+
+import List    ( nub )
+
+import {-# SOURCE #-} CgBindery ( CgIdInfo(..), CgBindings, maybeAStkLoc, maybeBStkLoc, nukeVolatileBinds )
+import {-# SOURCE #-} CgUsages
 
 import AbsCSyn
 import AbsCUtils       ( mkAbsCStmts )
@@ -56,22 +58,24 @@ import CmdLineOpts  ( opt_SccProfilingOn, opt_DoTickyProfiling,
                          opt_OmitBlackHoling
                        )
 import HeapOffs                ( maxOff,
-                         VirtualSpAOffset(..), VirtualSpBOffset(..)
+                         VirtualSpAOffset, VirtualSpBOffset,
+                         HeapOffset
                        )
+import CLabel           ( CLabel )
 import Id              ( idType,
                          nullIdEnv, mkIdEnv, addOneToIdEnv,
-                         modifyIdEnv, lookupIdEnv, rngIdEnv, IdEnv(..),
-                         ConTag(..), GenId{-instance Outputable-}
+                         modifyIdEnv, lookupIdEnv, rngIdEnv, IdEnv,
+                         ConTag, GenId{-instance Outputable-},
+                         Id
                        )
+import Literal          ( Literal )
 import Maybes          ( maybeToBool )
-import PprStyle                ( PprStyle(..) )
-import PprType         ( GenType{-instance Outputable-} )
-import Pretty          ( ppAboves, ppCat, ppStr )
 import PrimRep         ( getPrimRepSize, PrimRep(..) )
-import StgSyn          ( StgLiveVars(..) )
+import StgSyn          ( StgLiveVars )
 import Type            ( typePrimRep )
 import UniqSet         ( elementOfUniqSet )
-import Util            ( sortLt, panic, pprPanic )
+import Util            ( sortLt )
+import Outputable
 
 infixr 9 `thenC`       -- Right-associative!
 infixr 9 `thenFC`
@@ -323,7 +327,7 @@ thenC :: Code
 -- thenC :: Code -> Code    -> Code
 -- thenC :: Code -> FCode a -> FCode a
 
-(m `thenC` k) info_down state
+thenC m k info_down state
   = k info_down new_state
   where
     new_state  = m info_down state
@@ -353,7 +357,7 @@ thenFC      :: FCode a
 -- thenFC :: FCode a -> (a -> FCode b) -> FCode b
 -- thenFC :: FCode a -> (a -> Code)    -> Code
 
-(m `thenFC` k) info_down state
+thenFC m k info_down state
   = k m_result info_down new_state
   where
     (m_result, new_state) = m info_down state
@@ -649,7 +653,7 @@ is just a wrapper for its lower-level @Bind@ routine (drop the \tr{C}
 on the end of each function name).
 
 A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
-The name should not already be bound.
+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)
@@ -669,7 +673,7 @@ addBindsC new_bindings info_down (MkCgState absC binds usage)
 \begin{code}
 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
 modifyBindC name mangle_fn info_down (MkCgState absC binds usage)
-  = MkCgState absC (modifyIdEnv binds mangle_fn name) usage
+  = MkCgState absC (modifyIdEnv mangle_fn binds name) usage
 \end{code}
 
 Lookup is expected to find a binding for the @Id@.
@@ -687,19 +691,19 @@ lookupBindC name info_down@(MkCgInfoDown _ static_binds _)
                   Just this -> this
                   Nothing
                     -> pprPanic "lookupBindC:no info!\n"
-                       (ppAboves [
-                           ppCat [ppStr "for:", ppr PprShowAll name],
-                           ppStr "(probably: data dependencies broken by an optimisation pass)",
-                           ppStr "static binds for:",
-                           ppAboves [ ppr PprDebug i | (MkCgIdInfo i _ _ _) <- rngIdEnv static_binds ],
-                           ppStr "local binds for:",
-                           ppAboves [ ppr PprDebug i | (MkCgIdInfo i _ _ _) <- rngIdEnv local_binds ]
+                       (vcat [
+                           hsep [ptext SLIT("for:"), ppr name],
+                           ptext SLIT("(probably: data dependencies broken by an optimisation pass)"),
+                           ptext SLIT("static binds for:"),
+                           vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngIdEnv static_binds ],
+                           ptext SLIT("local binds for:"),
+                           vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngIdEnv local_binds ]
                         ])
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[CgStackery-deadslots]{Finding dead stack slots}
+\subsection[CgMonad-deadslots]{Finding dead stack slots}
 %*                                                                     *
 %************************************************************************