%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgExpr.lhs,v 1.42 2001/03/13 12:50:30 simonmar Exp $
+% $Id: CgExpr.lhs,v 1.47 2001/11/19 16:34:12 simonpj Exp $
%
%********************************************************
%* *
tailCallPrimOp, returnUnboxedTuple
)
import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo,
- mkApLFInfo, layOutDynCon )
+ mkApLFInfo, layOutDynConstr )
import CostCentre ( sccAbleCostCentre, isSccCountCostCentre )
import Id ( idPrimRep, idType, Id )
import VarSet
import PrimOp ( primOpOutOfLine, getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..) )
import PrimRep ( PrimRep(..), isFollowableRep )
-import TyCon ( maybeTyConSingleCon,
- isUnboxedTupleTyCon, isEnumerationTyCon )
+import TyCon ( isUnboxedTupleTyCon, isEnumerationTyCon )
import Type ( Type, typePrimRep, tyConAppArgs, tyConAppTyCon, repType )
import Maybes ( maybeToBool )
import ListSetOps ( assocMaybe )
import Unique ( mkBuiltinUnique )
import BasicTypes ( TopLevelFlag(..), RecFlag(..) )
+import Util ( lengthIs )
import Outputable
\end{code}
call, so we treat it as an inline primop.
\begin{code}
-cgExpr (StgPrimApp op@(CCallOp ccall) args res_ty)
+cgExpr (StgOpApp op@(StgFCallOp _ _) args res_ty)
= primRetUnboxedTuple op args res_ty
-- tagToEnum# is special: we need to pull the constructor out of the table,
-- and perform an appropriate return.
-cgExpr (StgPrimApp TagToEnumOp [arg] res_ty)
+cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
= ASSERT(isEnumerationTyCon tycon)
getArgAmode arg `thenFC` \amode ->
-- save the tag in a temporary in case amode overlaps
tycon = tyConAppTyCon res_ty
-cgExpr x@(StgPrimApp op args res_ty)
- | primOpOutOfLine op = tailCallPrimOp op args
+cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
+ | primOpOutOfLine primop
+ = tailCallPrimOp primop args
+
| otherwise
- = ASSERT(op /= SeqOp) -- can't handle SeqOp
+ = ASSERT(primop /= SeqOp) -- can't handle SeqOp
getArgAmodes args `thenFC` \ arg_amodes ->
- case (getPrimOpResultInfo op) of
+ case (getPrimOpResultInfo primop) of
ReturnsPrim kind ->
let result_amode = CReg (dataReturnConvPrim kind) in
[(con, params, use_mask,
(StgApp selectee [{-no args-}]))]
StgNoDefault))
- | the_fv == scrutinee -- Scrutinee is the only free variable
- && maybeToBool maybe_offset -- Selectee is a component of the tuple
+ | the_fv == scrutinee -- Scrutinee is the only free variable
+ && maybeToBool maybe_offset -- Selectee is a component of the tuple
&& offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough
- = ASSERT(is_single_constructor)
+ = -- NOT TRUE: ASSERT(is_single_constructor)
+ -- The simplifier may have statically determined that the single alternative
+ -- is the only possible case and eliminated the others, even if there are
+ -- other constructors in the datatype. It's still ok to make a selector
+ -- thunk in this case, because we *know* which constructor the scrutinee
+ -- will evaluate to.
cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
where
lf_info = mkSelectorLFInfo (idType bndr) offset_into_int
- (isUpdatable upd_flag)
- (_, params_w_offsets) = layOutDynCon con idPrimRep params
+ (isUpdatable upd_flag)
+ (_, params_w_offsets) = layOutDynConstr bogus_name con idPrimRep params
+ -- Just want the layout
maybe_offset = assocMaybe params_w_offsets selectee
Just the_offset = maybe_offset
offset_into_int = the_offset - fixedHdrSize
- is_single_constructor = maybeToBool (maybeTyConSingleCon tycon)
+ bogus_name = panic "mkRhsClosure"
\end{code}
-
Ap thunks
~~~~~~~~~
[] -- No args; a thunk
body@(StgApp fun_id args)
- | length args + 1 == arity
+ | args `lengthIs` (arity-1)
&& all isFollowableRep (map idPrimRep fvs)
&& isUpdatable upd_flag
&& arity <= mAX_SPEC_AP_SIZE
~~~~~~~~~~~~~~~~
\begin{code}
mkRhsClosure bndr cc bi srt fvs upd_flag args body
- = getSRTLabel `thenFC` \ srt_label ->
- let lf_info =
- mkClosureLFInfo bndr NotTopLevel fvs upd_flag args srt_label srt
- in
- cgRhsClosure bndr cc bi fvs args body lf_info
+ = cgRhsClosure bndr cc bi srt fvs args body lf_info
+ where
+ lf_info = mkClosureLFInfo bndr NotTopLevel fvs upd_flag args
\end{code}
\begin{code}
-primRetUnboxedTuple :: PrimOp -> [StgArg] -> Type -> Code
+primRetUnboxedTuple :: StgOp -> [StgArg] -> Type -> Code
primRetUnboxedTuple op args res_ty
= getArgAmodes args `thenFC` \ arg_amodes ->
{-