{-# OPTIONS -fno-warn-tabs #-}-- The above warning supression flag is a temporary kludge.-- While working on this module you are encouraged to remove it and-- detab the module (please do the detabbing in a separate patch). See-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces-- for detailsmoduleCgExpr(cgExpr)where#include "HsVersions.h"importConstantsimportStgSynimportCgMonadimportCostCentreimportSMRepimportCoreSynimportCgProfimportCgHeaperyimportCgBinderyimportCgCaseimportCgClosureimportCgConimportCgLetNoEscapeimportCgTailCallimportCgInfoTblsimportCgForeignCallimportCgPrimOpimportCgHpcimportCgUtilsimportClosureInfoimportOldCmmimportOldCmmUtilsimportVarSetimportLiteralimportPrimOpimportIdimportTyConimportTypeimportMaybesimportListSetOpsimportBasicTypesimportUtilimportOutputableimportStaticFlags

\end{code}
This module provides the support code for @StgToAbstractC@ to deal
with STG {\em expressions}. See also @CgClosure@, which deals
with closures, and @CgCon@, which deals with constructors.
\begin{code}

\end{code}
%********************************************************
%* *
%* PrimOps and foreign calls.
%* *
%********************************************************
NOTE about "safe" foreign calls: a safe foreign call is never compiled
inline in a case expression. When we see
case (ccall ...) of { ... }
We generate a proper return address for the alternatives and push the
stack frame before doing the call, so that in the event that the call
re-enters the RTS the stack is in a sane state.
\begin{code}

cgExpr(StgOpApp(StgFCallOpfcall_)stg_argsres_ty)=do{-
First, copy the args into temporaries. We're going to push
a return address right before doing the call, so the args
must be out of the way.
-}reps_n_amodes<-getArgAmodesstg_argslet-- Get the *non-void* args, and jiggle them with shimForeignCallarg_exprs=[(shimForeignCallArgstg_argexpr,stg_arg)|(stg_arg,(rep,expr))<-stg_args`zip`reps_n_amodes,nonVoidArgrep]arg_tmps<-sequence[assignTemparg|(arg,_)<-arg_exprs]letarg_hints=zipWithCmmHintedarg_tmps(map(typeForeignHint.stgArgType)stg_args){-
Now, allocate some result regs.
-}(res_reps,res_regs,res_hints)<-newUnboxedTupleRegsres_tyccallReturnUnboxedTuple(zipres_reps(map(CmmReg.CmmLocal)res_regs))$emitForeignCall(zipWithCmmHintedres_regsres_hints)fcallarg_hintsemptyVarSet{-no live vars-}-- tagToEnum# is special: we need to pull the constructor out of the table,-- and perform an appropriate return.cgExpr(StgOpApp(StgPrimOpTagToEnumOp)[arg]res_ty)=ASSERT(isEnumerationTyContycon)do{(_rep,amode)<-getArgAmodearg;amode'<-assignTempamode-- We're going to use it twice,-- so save in a temp if non-trivial;stmtC(CmmAssignnodeReg(tagToClosuretyconamode'));performReturn$emitReturnInstr(Just[node])}where-- If you're reading this code in the attempt to figure-- out why the compiler panic'ed here, it is probably because-- you used tagToEnum# in a non-monomorphic setting, e.g., -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#-- That won't work.tycon=tyConAppTyConres_tycgExpr(StgOpApp(StgPrimOpSeqOp)[StgVarArga,_]_res_ty)=cgTailCalla[]-- seq# :: a -> State# -> (# State# , a #)-- but the return convention for (# State#, a #) is exactly the same as-- for just a, so we can implment seq# by-- seq# a s ==> acgExpr(StgOpApp(StgPrimOpprimop)argsres_ty)|primOpOutOfLineprimop=tailCallPrimOpprimopargs|ReturnsPrimVoidRep<-result_info=docgPrimOp[]primopargsemptyVarSet-- ToDo: STG Live -- worried about thisperformReturn$emitReturnInstr(Just[])|ReturnsPrimrep<-result_info=dores<-newTemp(typeCmmTyperes_ty)cgPrimOp[res]primopargsemptyVarSetperformPrimReturn(primRepToCgReprep)(CmmReg(CmmLocalres))|ReturnsAlgtycon<-result_info,isUnboxedTupleTyContycon=do(reps,regs,_hints)<-newUnboxedTupleRegsres_tycgPrimOpregsprimopargsemptyVarSet{-no live vars-}returnUnboxedTuple(zipreps(map(CmmReg.CmmLocal)regs))|ReturnsAlgtycon<-result_info,isEnumerationTyContycon-- c.f. cgExpr (...TagToEnumOp...)=dotag_reg<-newTempbWord-- The tag is a wordcgPrimOp[tag_reg]primopargsemptyVarSetstmtC(CmmAssignnodeReg(tagToClosuretycon(CmmReg(CmmLocaltag_reg))))-- ToDo: STG Live -- worried about thisperformReturn$emitReturnInstr(Just[node])whereresult_info=getPrimOpResultInfoprimopcgExpr(StgOpApp(StgPrimCallOpprimcall)args_res_ty)=tailCallPrimCallprimcallargs

cgExpr(StgLetNoEscapelive_in_whole_letlive_in_rhssbindingsbody)=do{-- Figure out what volatile variables to save;nukeDeadBindingslive_in_whole_let;(save_assts,rhs_eob_info,maybe_cc_slot)<-saveVolatileVarsAndRegslive_in_rhss-- Save those variables right now!;emitStmtssave_assts-- Produce code for the rhss-- and add suitable bindings to the environment;cgLetNoEscapeBindingslive_in_rhssrhs_eob_infomaybe_cc_slotbindings-- Do the body;setEndOfBlockInforhs_eob_info(cgExprbody)}

cgRhs::Id->StgRhs->FCode(Id,CgIdInfo)-- the Id is passed along so a binding can be set upcgRhsname(StgRhsConmaybe_ccconargs)=do{amodes<-getArgAmodesargs;idinfo<-buildDynConnamemaybe_ccconamodes;returnFC(name,idinfo)}cgRhsname(StgRhsClosureccbifvsupd_flagsrtargsbody)=setSRTsrt$mkRhsClosurenameccbifvsupd_flagargsbody

\end{code}
mkRhsClosure looks for two special forms of the right-hand side:
a) selector thunks.
b) AP thunks
If neither happens, it just calls mkClosureLFInfo. You might think
that mkClosureLFInfo should do all this, but it seems wrong for the
latter to look at the structure of an expression
Selectors
~~~~~~~~~
We look at the body of the closure to see if it's a selector---turgid,
but nothing deep. We are looking for a closure of {\em exactly} the
form:
... = [the_fv] \ u [] ->
case the_fv of
con a_1 ... a_n -> a_i
\begin{code}

mkRhsClosure::Id->CostCentreStack->StgBinderInfo->[Id]->UpdateFlag->[Id]->GenStgExprIdId->FCode(Id,CgIdInfo)mkRhsClosurebndrccbi[the_fv]-- Just one free varupd_flag-- Updatable thunk[]-- A thunkbody@(StgCase(StgAppscrutinee[{-no args-}])___srt-- ignore uniq, etc.(AlgAlt_)[(DataAltcon,params,_use_mask,(StgAppselectee[{-no args-}]))])|the_fv==scrutinee-- Scrutinee is the only free variable&&maybeToBoolmaybe_offset-- Selectee is a component of the tuple&&offset_into_int<=mAX_SPEC_SELECTEE_SIZE-- Offset is small enough=-- 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.setSRTsrt$cgStdRhsClosurebndrccbi[the_fv][]bodylf_info[StgVarArgthe_fv]wherelf_info=mkSelectorLFInfobndroffset_into_int(isUpdatableupd_flag)(_,params_w_offsets)=layOutDynConstrcon(addIdRepsparams)-- Just want the layoutmaybe_offset=assocMaybeparams_w_offsetsselecteeJustthe_offset=maybe_offsetoffset_into_int=the_offset-fixedHdrSize

\end{code}
Ap thunks
~~~~~~~~~
A more generic AP thunk of the form
x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
A set of these is compiled statically into the RTS, so we just use
those. We could extend the idea to thunks where some of the x_i are
global ids (and hence not free variables), but this would entail
generating a larger thunk. It might be an option for non-optimising
compilation, though.
We only generate an Ap thunk if all the free variables are pointers,
for semi-obvious reasons.
\begin{code}

mkRhsClosurebndrccbifvsupd_flag[]-- No args; a thunkbody@(StgAppfun_idargs)|args`lengthIs`(arity-1)&&allisFollowableArg(mapidCgRepfvs)&&isUpdatableupd_flag&&arity<=mAX_SPEC_AP_SIZE&&notopt_SccProfilingOn-- not when profiling: we don't want to-- lose information about this particular-- thunk (e.g. its type) (#949)-- Ha! an Ap thunk=cgStdRhsClosurebndrccbifvs[]bodylf_infopayloadwherelf_info=mkApLFInfobndrupd_flagarity-- the payload has to be in the correct order, hence we can't-- just use the fvs.payload=StgVarArgfun_id:argsarity=lengthfvs

cgLetNoEscapeBindings::StgLiveVars->EndOfBlockInfo->MaybeVirtualSpOffset->GenStgBindingIdId->CodecgLetNoEscapeBindingslive_in_rhssrhs_eob_infomaybe_cc_slot(StgNonRecbinderrhs)=do{(binder,info)<-cgLetNoEscapeRhslive_in_rhssrhs_eob_infomaybe_cc_slotNonRecursivebinderrhs;addBindCbinderinfo}cgLetNoEscapeBindingslive_in_rhssrhs_eob_infomaybe_cc_slot(StgRecpairs)=do{new_bindings<-fixC(\new_bindings->do{addBindsCnew_bindings;listFCs[cgLetNoEscapeRhsfull_live_in_rhssrhs_eob_infomaybe_cc_slotRecursivebe|(b,e)<-pairs]});addBindsCnew_bindings}where-- We add the binders to the live-in-rhss set so that we don't-- delete the bindings for the binder from the environment!full_live_in_rhss=live_in_rhss`unionVarSet`(mkVarSet[b|(b,_)<-pairs])cgLetNoEscapeRhs::StgLiveVars-- Live in rhss->EndOfBlockInfo->MaybeVirtualSpOffset->RecFlag->Id->StgRhs->FCode(Id,CgIdInfo)cgLetNoEscapeRhsfull_live_in_rhssrhs_eob_infomaybe_cc_slotrecbinder(StgRhsClosureccbi__upd_flagsrtargsbody)=-- 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 bodysetSRTsrt$cgLetNoEscapeClosurebinderccbifull_live_in_rhssrhs_eob_infomaybe_cc_slotrecargsbody-- 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!cgLetNoEscapeRhsfull_live_in_rhssrhs_eob_infomaybe_cc_slotrecbinder(StgRhsConccconargs)=setSRTNoSRT$cgLetNoEscapeClosurebinderccnoBinderInfo{-safe-}full_live_in_rhssrhs_eob_infomaybe_cc_slotrec[]--No args; the binder is data structure, not a function(StgConAppconargs)