[project @ 1996-06-30 15:56:44 by partain]
[ghc-hetmet.git] / ghc / compiler / codeGen / CgBindery.lhs
index 534fa94..6e0c8bd 100644 (file)
@@ -7,7 +7,7 @@
 #include "HsVersions.h"
 
 module CgBindery (
-       CgBindings(..), CgIdInfo(..){-dubiously concrete-},
+       SYN_IE(CgBindings), CgIdInfo(..){-dubiously concrete-},
        StableLoc, VolatileLoc,
 
        maybeAStkLoc, maybeBStkLoc,
@@ -26,30 +26,30 @@ module CgBindery (
        rebindToAStack, rebindToBStack
     ) where
 
-import Ubiq{-uitous-}
-import CgLoop1         -- here for paranoia-checking
+IMP_Ubiq(){-uitous-}
+IMPORT_DELOOPER(CgLoop1)               -- here for paranoia-checking
 
 import AbsCSyn
 import CgMonad
 
 import CgUsages                ( getHpRelOffset, getSpARelOffset, getSpBRelOffset )
 import CLabel          ( mkClosureLabel )
-import ClosureInfo     ( mkLFImported, mkConLFInfo, mkLFArgument )
-import HeapOffs                ( VirtualHeapOffset(..),
-                         VirtualSpAOffset(..), VirtualSpBOffset(..)
+import ClosureInfo     ( mkLFImported, mkConLFInfo, mkLFArgument, LambdaFormInfo )
+import HeapOffs                ( SYN_IE(VirtualHeapOffset),
+                         SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset)
                        )
 import Id              ( idPrimRep, toplevelishId, isDataCon,
-                         mkIdEnv, rngIdEnv, IdEnv(..),
+                         mkIdEnv, rngIdEnv, SYN_IE(IdEnv),
                          idSetToList,
                          GenId{-instance NamedThing-}
                        )
 import Maybes          ( catMaybes )
-import Name            ( isLocallyDefined )
+import Name            ( isLocallyDefined, oddlyImportedName, Name{-instance NamedThing-} )
 #ifdef DEBUG
 import PprAbsC         ( pprAmode )
 #endif
 import PprStyle                ( PprStyle(..) )
-import StgSyn          ( StgArg(..), StgLiveVars(..), GenStgArg(..) )
+import StgSyn          ( SYN_IE(StgArg), SYN_IE(StgLiveVars), GenStgArg(..) )
 import Unpretty                ( uppShow )
 import Util            ( zipWithEqual, panic )
 \end{code}
@@ -194,21 +194,28 @@ I {\em think} all looking-up is done through @getCAddrMode(s)@.
 \begin{code}
 getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
 
-getCAddrModeAndInfo name
-  | not (isLocallyDefined name)
-  = returnFC (global_amode, mkLFImported name)
-
-  | isDataCon name
-  = returnFC (global_amode, mkConLFInfo name)
+getCAddrModeAndInfo id
+  | not (isLocallyDefined name) || oddlyImportedName name
+    {- Why the "oddlyImported"?
+       Imagine you are compiling GHCbase.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
+       assumes those values are ubiquitously available.
+       The main point is: it may inject calls to them earlier
+       in GHCbase.hs than the actual definition...
+    -}
+  = returnFC (global_amode, mkLFImported id)
 
   | otherwise = -- *might* be a nested defn: in any case, it's something whose
                -- definition we will know about...
-    lookupBindC name `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
+    lookupBindC id `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
     idInfoPiecesToAmode kind volatile_loc stable_loc `thenFC` \ amode ->
     returnFC (amode, lf_info)
   where
-    global_amode = CLbl (mkClosureLabel name) kind
-    kind = idPrimRep name
+    name = getName id
+    global_amode = CLbl (mkClosureLabel id) kind
+    kind = idPrimRep id
 
 getCAddrMode :: Id -> FCode CAddrMode
 getCAddrMode name
@@ -340,7 +347,7 @@ bindNewToLit name lit
 
 bindArgsToRegs :: [Id] -> [MagicId] -> Code
 bindArgsToRegs args regs
-  = listCs (zipWithEqual bind args regs)
+  = listCs (zipWithEqual "bindArgsToRegs" bind args regs)
   where
     arg `bind` reg = bindNewToReg arg reg mkLFArgument
 \end{code}