[project @ 1996-06-11 13:18:54 by partain]

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

diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs
index 4d17fc1..92d6af2 100644 (file)
--- a/ghc/compiler/codeGen/CgBindery.lhs
+++ b/ghc/compiler/codeGen/CgBindery.lhs
@@ -26,8 +26,8 @@ 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
@@ -44,7 +44,10 @@ import Id            ( idPrimRep, toplevelishId, isDataCon,
                          GenId{-instance NamedThing-}
                        )
 import Maybes          ( catMaybes )
+import Name            ( isLocallyDefined, oddlyImportedName, Name{-instance NamedThing-} )
+#ifdef DEBUG
 import PprAbsC         ( pprAmode )
+#endif
 import PprStyle                ( PprStyle(..) )
 import StgSyn          ( StgArg(..), StgLiveVars(..), GenStgArg(..) )
 import Unpretty                ( uppShow )
@@ -122,7 +125,7 @@ newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo)
 newTempAmodeAndIdInfo name lf_info
   = (temp_amode, temp_idinfo)
   where
-    uniq               = getItsUnique name
+    uniq               = uniqueOf name
     temp_amode = CTemp uniq (idPrimRep name)
     temp_idinfo = tempIdInfo name uniq lf_info
 
@@ -191,21 +194,22 @@ 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)
+getCAddrModeAndInfo id
+  | not (isLocallyDefined name) || oddlyImportedName name
+  = returnFC (global_amode, mkLFImported id)
 
-  | isDataCon name
-  = returnFC (global_amode, mkConLFInfo name)
+  | isDataCon id
+  = returnFC (global_amode, mkConLFInfo 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
@@ -337,7 +341,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}