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

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

diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index d30731f..8e8b5e2 100644 (file)
--- a/ghc/compiler/codeGen/CgExpr.lhs
+++ b/ghc/compiler/codeGen/CgExpr.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgExpr.lhs,v 1.33 2000/03/27 16:22:09 simonpj Exp $
+% $Id: CgExpr.lhs,v 1.40 2000/11/24 09:51:38 simonpj Exp $
 %
 %********************************************************
 %*                                                     *
@@ -39,16 +39,13 @@ import ClosureInfo  ( mkClosureLFInfo, mkSelectorLFInfo,
 import CostCentre      ( sccAbleCostCentre, isSccCountCostCentre )
 import Id              ( idPrimRep, idType, Id )
 import VarSet
-import DataCon         ( DataCon, dataConTyCon )
-import IdInfo          ( ArityInfo(..) )
-import PrimOp          ( primOpOutOfLine, ccallMayGC,
-                         getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..)
-                       )
-import PrimRep         ( getPrimRepSize, PrimRep(..), isFollowableRep )
+import PrimOp          ( primOpOutOfLine, getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..) )
+import PrimRep         ( PrimRep(..), isFollowableRep )
 import TyCon           ( maybeTyConSingleCon,
                          isUnboxedTupleTyCon, isEnumerationTyCon )
-import Type            ( Type, typePrimRep, splitTyConApp_maybe, repType )
-import Maybes          ( assocMaybe, maybeToBool )
+import Type            ( Type, typePrimRep, tyConAppArgs, tyConAppTyCon, repType )
+import Maybes          ( maybeToBool )
+import ListSetOps      ( assocMaybe )
 import Unique          ( mkBuiltinUnique )
 import BasicTypes      ( TopLevelFlag(..), RecFlag(..) )
 import Outputable
@@ -145,7 +142,7 @@ cgExpr (StgPrimApp TagToEnumOp [arg] res_ty)
           --
          -- That won't work.
           --
-       (Just (tycon,_)) = splitTyConApp_maybe res_ty
+       tycon = tyConAppTyCon res_ty
 
 
 cgExpr x@(StgPrimApp op args res_ty)
@@ -317,7 +314,7 @@ mkRhsClosure        bndr cc bi srt
                []                      -- A thunk
                body@(StgCase (StgApp scrutinee [{-no args-}])
                      _ _ _ _   -- ignore uniq, etc.
-                     (StgAlgAlts case_ty
+                     (StgAlgAlts (Just tycon)
                         [(con, params, use_mask,
                            (StgApp selectee [{-no args-}]))]
                         StgNoDefault))
@@ -334,7 +331,6 @@ mkRhsClosure        bndr cc bi srt
     Just the_offset      = maybe_offset
     offset_into_int       = the_offset - fixedHdrSize
     is_single_constructor = maybeToBool (maybeTyConSingleCon tycon)
-    tycon                = dataConTyCon con
 \end{code}
 
 
@@ -465,12 +461,10 @@ primRetUnboxedTuple op args res_ty
       allocate some temporaries for the return values.
     -}
     let
-      (tc,ty_args)      = case splitTyConApp_maybe (repType res_ty) of
-                           Nothing -> pprPanic "primRetUnboxedTuple" (ppr res_ty)
-                           Just pr -> pr
-      prim_reps          = map typePrimRep ty_args
-      temp_uniqs         = map mkBuiltinUnique [ n_args .. n_args + length ty_args - 1]
-      temp_amodes        = zipWith CTemp temp_uniqs prim_reps
+      ty_args     = tyConAppArgs (repType res_ty)
+      prim_reps   = map typePrimRep ty_args
+      temp_uniqs  = map mkBuiltinUnique [ n_args .. n_args + length ty_args - 1]
+      temp_amodes = zipWith CTemp temp_uniqs prim_reps
     in
     returnUnboxedTuple temp_amodes (absC (COpStmt temp_amodes op arg_temps []))
 \end{code}