%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgExpr.lhs,v 1.31 2000/03/23 17:45:19 simonpj Exp $
+% $Id: CgExpr.lhs,v 1.44 2001/09/26 15:11:50 simonpj Exp $
%
%********************************************************
%* *
tailCallPrimOp, returnUnboxedTuple
)
import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo,
- mkApLFInfo, layOutDynCon )
+ mkApLFInfo, layOutDynConstr )
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
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
--
-- That won't work.
--
- (Just (tycon,_)) = splitTyConApp_maybe res_ty
+ tycon = tyConAppTyCon res_ty
+
+cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
+ | primOpOutOfLine primop
+ = tailCallPrimOp primop args
-cgExpr x@(StgPrimApp op args res_ty)
- | primOpOutOfLine op = tailCallPrimOp op 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
\subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
\begin{code}
-cgExpr (StgLet (StgNonRec name rhs) expr)
- = cgRhs name rhs `thenFC` \ (name, info) ->
+cgExpr (StgLet (StgNonRec srt name rhs) expr)
+ = cgRhs srt name rhs `thenFC` \ (name, info) ->
addBindC name info `thenC`
cgExpr expr
-cgExpr (StgLet (StgRec pairs) expr)
+cgExpr (StgLet (StgRec srt pairs) expr)
= fixC (\ new_bindings -> addBindsC new_bindings `thenC`
- listFCs [ cgRhs b e | (b,e) <- pairs ]
+ listFCs [ cgRhs srt b e | (b,e) <- pairs ]
) `thenFC` \ new_bindings ->
addBindsC new_bindings `thenC`
in @CgClosure@ (to do closures).
\begin{code}
-cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
+cgRhs :: SRT -> Id -> StgRhs -> FCode (Id, CgIdInfo)
-- the Id is passed along so a binding can be set up
-cgRhs name (StgRhsCon maybe_cc con args)
+cgRhs srt name (StgRhsCon maybe_cc con args)
= getArgAmodes args `thenFC` \ amodes ->
buildDynCon name maybe_cc con amodes `thenFC` \ idinfo ->
returnFC (name, idinfo)
-cgRhs name (StgRhsClosure cc bi srt@(NoSRT) fvs upd_flag args body)
- = mkRhsClosure name cc bi srt fvs upd_flag args body
-cgRhs name (StgRhsClosure cc bi srt@(SRT _ _) fvs upd_flag args body)
+cgRhs srt name (StgRhsClosure cc bi fvs upd_flag args body)
= mkRhsClosure name cc bi srt fvs upd_flag args body
\end{code}
[] -- 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))
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)
- tycon = dataConTyCon con
+ bogus_name = panic "mkRhsClosure"
\end{code}
-
-
Ap thunks
~~~~~~~~~
~~~~~~~~~~~~~~~~
\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}
-cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgNonRec binder rhs)
+cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
+ (StgNonRec srt binder rhs)
= cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot
- NonRecursive binder rhs
+ NonRecursive srt binder rhs
`thenFC` \ (binder, info) ->
addBindC binder info
-cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
+cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
+ (StgRec srt pairs)
= fixC (\ new_bindings ->
addBindsC new_bindings `thenC`
listFCs [ cgLetNoEscapeRhs full_live_in_rhss
- rhs_eob_info maybe_cc_slot Recursive b e
+ rhs_eob_info maybe_cc_slot Recursive srt b e
| (b,e) <- pairs ]
) `thenFC` \ new_bindings ->
-> EndOfBlockInfo
-> Maybe VirtualSpOffset
-> RecFlag
+ -> SRT
-> Id
-> StgRhs
-> FCode (Id, CgIdInfo)
-cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
- (StgRhsClosure cc bi srt _ upd_flag args body)
+cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec srt binder
+ (StgRhsClosure cc bi _ upd_flag args body)
= -- We could check the update flag, but currently we don't switch it off
-- for let-no-escaped things, so we omit the check too!
-- case upd_flag of
-- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
-- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
- cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info maybe_cc_slot rec args body
+ cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info
+ maybe_cc_slot rec args body
-- For a constructor RHS we want to generate a single chunk of code which
-- can be jumped to from many places, which will return the constructor.
-- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
-cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
+cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec srt binder
(StgRhsCon cc con args)
- = cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} NoSRT full_live_in_rhss rhs_eob_info maybe_cc_slot rec
+ = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} srt
+ full_live_in_rhss rhs_eob_info maybe_cc_slot rec
[] --No args; the binder is data structure, not a function
(StgConApp con 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 ->
{-
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}