[project @ 1998-01-09 12:10:37 by simonm]

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

diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs
index 6e0c8bd..f21d393 100644 (file)
--- a/ghc/compiler/codeGen/CgBindery.lhs
+++ b/ghc/compiler/codeGen/CgBindery.lhs
@@ -4,10 +4,8 @@
 \section[CgBindery]{Utility functions related to doing @CgBindings@}
 
 \begin{code}
-#include "HsVersions.h"
-
 module CgBindery (
-       SYN_IE(CgBindings), CgIdInfo(..){-dubiously concrete-},
+       CgBindings, CgIdInfo(..){-dubiously concrete-},
        StableLoc, VolatileLoc,
 
        maybeAStkLoc, maybeBStkLoc,
@@ -26,32 +24,32 @@ module CgBindery (
        rebindToAStack, rebindToBStack
     ) where
 
-IMP_Ubiq(){-uitous-}
-IMPORT_DELOOPER(CgLoop1)               -- here for paranoia-checking
+#include "HsVersions.h"
 
 import AbsCSyn
 import CgMonad
 
 import CgUsages                ( getHpRelOffset, getSpARelOffset, getSpBRelOffset )
-import CLabel          ( mkClosureLabel )
+import CLabel          ( mkStaticClosureLabel, mkClosureLabel )
 import ClosureInfo     ( mkLFImported, mkConLFInfo, mkLFArgument, LambdaFormInfo )
-import HeapOffs                ( SYN_IE(VirtualHeapOffset),
-                         SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset)
+import HeapOffs                ( VirtualHeapOffset,
+                         VirtualSpAOffset, VirtualSpBOffset
                        )
-import Id              ( idPrimRep, toplevelishId, isDataCon,
-                         mkIdEnv, rngIdEnv, SYN_IE(IdEnv),
+import Id              ( idPrimRep, toplevelishId, 
+                         mkIdEnv, rngIdEnv, IdEnv,
                          idSetToList,
-                         GenId{-instance NamedThing-}
+                         Id
                        )
+import Literal         ( Literal )
 import Maybes          ( catMaybes )
-import Name            ( isLocallyDefined, oddlyImportedName, Name{-instance NamedThing-} )
-#ifdef DEBUG
+import Name            ( isLocallyDefined, isWiredInName,
+                         Name{-instance NamedThing-}, NamedThing(..) )
 import PprAbsC         ( pprAmode )
-#endif
-import PprStyle                ( PprStyle(..) )
-import StgSyn          ( SYN_IE(StgArg), SYN_IE(StgLiveVars), GenStgArg(..) )
-import Unpretty                ( uppShow )
+import PrimRep          ( PrimRep )
+import StgSyn          ( StgArg, StgLiveVars, GenStgArg(..) )
+import Unique           ( Unique, Uniquable(..) )
 import Util            ( zipWithEqual, panic )
+import Outputable
 \end{code}
 
 
@@ -89,7 +87,12 @@ data VolatileLoc
 
   | VirNodeLoc VirtualHeapOffset       -- Cts of offset indirect from Node
                                        -- ie *(Node+offset)
+\end{code}
+
+@StableLoc@ encodes where an Id can be found, used by
+the @CgBindings@ environment in @CgBindery@.
 
+\begin{code}
 data StableLoc
   = NoStableLoc
   | VirAStkLoc         VirtualSpAOffset
@@ -195,9 +198,9 @@ I {\em think} all looking-up is done through @getCAddrMode(s)@.
 getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
 
 getCAddrModeAndInfo id
-  | not (isLocallyDefined name) || oddlyImportedName name
-    {- Why the "oddlyImported"?
-       Imagine you are compiling GHCbase.hs (a module that
+  | not (isLocallyDefined name) || isWiredInName name
+    {- Why the "isWiredInName"?
+       Imagine you are compiling PrelBase.hs (a module that
        supplies some of the wired-in values).  What can
        happen is that the compiler will inject calls to
        (e.g.) GHCbase.unpackPS, where-ever it likes -- it
@@ -291,7 +294,42 @@ getArgAmodes (atom:atoms)
 
 getArgAmode :: StgArg -> FCode CAddrMode
 
-getArgAmode (StgVarArg var) = getCAddrMode var
+getArgAmode (StgConArg var)
+     {- Why does this case differ from StgVarArg?
+       Because the program might look like this:
+               data Foo a = Empty | Baz a
+               f a x = let c = Empty! a
+                       in h c
+       Now, when we go Core->Stg, we drop the type applications, 
+       so we can inline c, giving
+               f x = h Empty
+       Now we are referring to Empty as an argument (rather than in an STGCon), 
+       so we'll look it up with getCAddrMode.  We want to return an amode for
+       the static closure that we make for nullary constructors.  But if we blindly
+       go ahead with getCAddrMode we end up looking in the environment, and it ain't there!
+
+       This special case used to be in getCAddrModeAndInfo, but it doesn't work there.
+       Consider:
+               f a x = Baz a x
+       If the constructor Baz isn't inlined we simply want to treat it like any other
+       identifier, with a top level definition.  We don't want to spot that it's a constructor.
+
+       In short 
+               StgApp con args
+       and
+               StgCon con args
+       are treated differently; the former is a call to a bog standard function while the
+       latter uses the specially-labelled, pre-defined info tables etc for the constructor.
+
+       The way to think of this case in getArgAmode is that
+               SApp f Empty
+       is really
+               App f (StgCon Empty [])
+     -}
+  = returnFC (CLbl (mkStaticClosureLabel var) (idPrimRep var))
+
+getArgAmode (StgVarArg var) = getCAddrMode var         -- The common case
+
 getArgAmode (StgLitArg lit) = returnFC (CLit lit)
 \end{code}
 
@@ -375,7 +413,7 @@ bindNewPrimToAmode name (CVal (NodeRel offset) _)
 
 #ifdef DEBUG
 bindNewPrimToAmode name amode
-  = panic ("bindNew...:"++(uppShow 80 (pprAmode PprDebug  amode)))
+  = pprPanic "bindNew...:" (pprAmode amode)
 #endif
 \end{code}