[project @ 1997-06-05 21:31:08 by sof]

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

diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs
index 856a119..a50c659 100644 (file)
--- a/ghc/compiler/codeGen/CgRetConv.lhs
+++ b/ghc/compiler/codeGen/CgRetConv.lhs
@@ -20,29 +20,29 @@ module CgRetConv (
        assignPrimOpResultRegs,
        makePrimOpArgsRobust,
        assignRegs
-
-       -- and to make the interface self-sufficient...
     ) where
 
-import Ubiq{-uitous-}
-import AbsCLoop                -- paranoia checking
+IMP_Ubiq(){-uitous-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
+IMPORT_DELOOPER(AbsCLoop)              -- paranoia checking
+#endif
 
 import AbsCSyn         -- quite a few things
 import AbsCUtils       ( mkAbstractCs, getAmodeRep,
                          amodeCanSurviveGC
                        )
-import CgCompInfo      ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
+import Constants       ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
                          mAX_Vanilla_REG, mAX_Float_REG,
                          mAX_Double_REG
                        )
 import CmdLineOpts     ( opt_ReturnInRegsThreshold )
-import Id              ( isDataCon, dataConSig,
-                         DataCon(..), GenId{-instance Eq-}
+import Id              ( isDataCon, dataConRawArgTys,
+                         SYN_IE(DataCon), GenId{-instance Eq-},
+                         SYN_IE(Id)
                        )
 import Maybes          ( catMaybes )
-import PprStyle                ( PprStyle(..) )
+import Outputable      ( PprStyle(..), Outputable(..) )
 import PprType         ( TyCon{-instance Outputable-} )
-import PrelInfo                ( integerDataCon )
 import PrimOp          ( primOpCanTriggerGC,
                          getPrimOpResultInfo, PrimOpResultInfo(..),
                          PrimOp{-instance Outputable-}
@@ -50,8 +50,9 @@ import PrimOp         ( primOpCanTriggerGC,
 import PrimRep         ( isFloatingRep, PrimRep(..) )
 import TyCon           ( tyConDataCons, tyConFamilySize )
 import Type            ( typePrimRep )
+import Pretty          ( Doc )
 import Util            ( zipWithEqual, mapAccumL, isn'tIn,
-                         pprError, pprTrace, panic, assertPanic
+                         pprError, pprTrace, panic, assertPanic, assertPprPanic
                        )
 \end{code}
 
@@ -119,18 +120,16 @@ then it gives up, returning @ReturnInHeap@.
 dataReturnConvAlg :: DataCon -> DataReturnConvention
 
 dataReturnConvAlg data_con
-  = ASSERT(isDataCon data_con)
+  = ASSERT2(isDataCon data_con, (ppr PprDebug data_con))
     case leftover_kinds of
        []    ->        ReturnInRegs reg_assignment
        other ->        ReturnInHeap    -- Didn't fit in registers
   where
-    (_, _, arg_tys, _) = dataConSig data_con
+    arg_tys = dataConRawArgTys data_con
 
     (reg_assignment, leftover_kinds)
       = assignRegs [node, infoptr] -- taken...
                   (map typePrimRep arg_tys)
-
-    is_prim_result_ty = data_con == integerDataCon -- ***HACK***! (WDP 95/11)
 \end{code}
 
 %************************************************************************
@@ -158,7 +157,7 @@ dataReturnConvPrim ArrayRep     = VanillaReg ArrayRep ILIT(1)
 dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep ILIT(1)
 
 dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep ILIT(1)
-dataReturnConvPrim MallocPtrRep = VanillaReg MallocPtrRep ILIT(1)
+dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep ILIT(1)
 
 #ifdef DEBUG
 dataReturnConvPrim PtrRep      = panic "dataReturnConvPrim: PtrRep"
@@ -207,8 +206,8 @@ argument into it).
 
 Bug: it is assumed that robust amodes cannot contain pointers.  This
 seems reasonable but isn't true.  For example, \tr{Array#}'s
-\tr{MallocPtr#}'s are pointers.  (This is only known to bite on
-\tr{_ccall_GC_} with a MallocPtr argument.)
+\tr{ForeignObj#}'s are pointers.  (This is only known to bite on
+\tr{_ccall_GC_} with a ForeignObj argument.)
 
 See after for some ADR comments...