[project @ 2001-01-12 11:04:45 by simonmar]

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

diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index f14ecab..e09c085 100644 (file)
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -22,7 +22,7 @@ import StgSyn
 
 import AbsCUtils       ( getAmodeRep )
 import CgBindery       ( getArgAmodes, bindNewToNode,
-                         bindArgsToRegs, newTempAmodeAndIdInfo,
+                         bindArgsToRegs, 
                          idInfoToAmode, stableAmodeIdInfo,
                          heapIdInfo, CgIdInfo, bindNewToStack
                        )
@@ -31,7 +31,6 @@ import CgStackery     ( mkTaggedVirtStkOffsets, freeStackSlots,
                        )
 import CgUsages                ( getRealSp, getVirtSp, setRealAndVirtualSp,
                          getSpRelOffset )
-import CgClosure       ( cgTopRhsClosure )
 import CgRetConv       ( assignRegs )
 import Constants       ( mAX_INTLIKE, mIN_INTLIKE, mAX_CHARLIKE, mIN_CHARLIKE,
                          mIN_UPD_SIZE )
@@ -39,23 +38,23 @@ import CgHeapery    ( allocDynClosure, inPlaceAllocDynClosure )
 import CgTailCall      ( performReturn, mkStaticAlgReturnCode, doTailCall,
                          mkUnboxedTupleReturnCode )
 import CLabel          ( mkClosureLabel )
-import ClosureInfo     ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
+import ClosureInfo     ( mkConLFInfo, mkLFArgument,
                          layOutDynCon, layOutDynClosure,
                          layOutStaticClosure, closureSize
                        )
 import CostCentre      ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
                          currentCCS )
-import DataCon         ( DataCon, dataConName, dataConTag, dataConTyCon,
-                         isUnboxedTupleCon, isNullaryDataCon, dataConId, dataConWrapId
+import DataCon         ( DataCon, dataConName, dataConTag, 
+                         isUnboxedTupleCon, isNullaryDataCon, dataConId, 
+                         dataConWrapId, dataConRepArity
                        )
-import Id              ( Id, idName, idType, idPrimRep )
-import Name            ( nameModule, isLocallyDefinedName )
+import Id              ( Id, idName, idPrimRep )
 import Literal         ( Literal(..) )
 import PrelInfo                ( maybeCharLikeCon, maybeIntLikeCon )
 import PrimRep         ( PrimRep(..), isFollowableRep )
 import Unique          ( Uniquable(..) )
 import Util
-import Panic           ( assertPanic, trace )
+import Outputable
 \end{code}
 
 %************************************************************************
@@ -70,7 +69,15 @@ cgTopRhsCon :: Id            -- Name of thing bound to this RHS
            -> [StgArg]         -- Args
            -> FCode (Id, CgIdInfo)
 cgTopRhsCon id con args
-  = ASSERT(not dynamic_con_or_args)    -- checks for litlit args too
+  = ASSERT(not (isDllConApp con args)) -- checks for litlit args too
+    ASSERT(length args == dataConRepArity con)
+    let
+       name          = idName id
+       closure_label = mkClosureLabel name
+       lf_info       = mkConLFInfo con
+       cg_id_info    = stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info
+    in
+
     (
        -- LAY IT OUT
     getArgAmodes args          `thenFC` \ amodes ->
@@ -84,22 +91,13 @@ cgTopRhsCon id con args
     absC (CStaticClosure
            closure_label               -- Labelled with the name on lhs of defn
            closure_info                -- Closure is static
-           top_ccc
+           (mkCCostCentreStack dontCareCCS) -- because it's static data
            (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
 
     ) `thenC`
 
        -- RETURN
     returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
-  where
-    lf_info        = mkConLFInfo    con
-    closure_label   = mkClosureLabel name
-    name            = idName id
-
-    top_ccc = mkCCostCentreStack dontCareCCS -- because it's static data
-
-    -- stuff needed by the assert pred only.
-    dynamic_con_or_args = isDllConApp con args
 \end{code}
 
 %************************************************************************
@@ -170,8 +168,6 @@ buildDynCon binder cc con [arg_amode]
   | maybeIntLikeCon con && in_range_int_lit arg_amode
   = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
   where
-    (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
-
     in_range_int_lit (CLit (MachInt val)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
     in_range_int_lit _other_amode        = False
 
@@ -179,8 +175,6 @@ buildDynCon binder cc con [arg_amode]
   | maybeCharLikeCon con && in_range_char_lit arg_amode
   = returnFC (stableAmodeIdInfo binder (CCharLike arg_amode) (mkConLFInfo con))
   where
-    (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
-
     in_range_char_lit (CLit (MachChar val)) = val <= mAX_CHARLIKE && val >= mIN_CHARLIKE
     in_range_char_lit _other_amode         = False
 \end{code}
@@ -277,7 +271,8 @@ sure the @amodes@ passed don't conflict with each other.
 cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
 
 cgReturnDataCon con amodes
-  = getEndOfBlockInfo  `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
+  = ASSERT(length amodes == dataConRepArity con)
+    getEndOfBlockInfo  `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
 
     case sequel of