%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgExpr.lhs,v 1.32 2000/03/25 12:38:40 panne Exp $
+% $Id: CgExpr.lhs,v 1.40 2000/11/24 09:51:38 simonpj Exp $
%
%********************************************************
%* *
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 PprType ( {- instance Outputable Type -} )
-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
--
-- That won't work.
--
- (Just (tycon,_)) = splitTyConApp_maybe res_ty
+ tycon = tyConAppTyCon res_ty
cgExpr x@(StgPrimApp op args res_ty)
[] -- 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))
Just the_offset = maybe_offset
offset_into_int = the_offset - fixedHdrSize
is_single_constructor = maybeToBool (maybeTyConSingleCon tycon)
- tycon = dataConTyCon con
\end{code}
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}