%
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module CgExpr ( cgExpr ) where
#include "HsVersions.h"
then assignPtrTemp arg
else assignNonPtrTemp arg
| (arg, stg_arg) <- arg_exprs]
- let arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
+ let arg_hints = zipWith CmmHinted arg_tmps (map (typeHint.stgArgType) stg_args)
{-
Now, allocate some result regs.
-}
(res_reps,res_regs,res_hints) <- newUnboxedTupleRegs res_ty
ccallReturnUnboxedTuple (zip res_reps (map (CmmReg . CmmLocal) res_regs)) $
- emitForeignCall (zip res_regs res_hints) fcall
+ emitForeignCall (zipWith CmmHinted res_regs res_hints) fcall
arg_hints emptyVarSet{-no live vars-}
-- tagToEnum# is special: we need to pull the constructor out of the table,
else assignNonPtrTemp amode
-- We're going to use it twice,
-- so save in a temp if non-trivial
- ; this_pkg <- getThisPackage
- ; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode'))
+ ; stmtC (CmmAssign nodeReg (tagToClosure tycon amode'))
; performReturn emitReturnInstr }
where
-- If you're reading this code in the attempt to figure
= do tag_reg <- if isFollowableArg (typeCgRep res_ty)
then newPtrTemp wordRep
else newNonPtrTemp wordRep
- this_pkg <- getThisPackage
cgPrimOp [tag_reg] primop args emptyVarSet
stmtC (CmmAssign nodeReg
- (tagToClosure this_pkg tycon
+ (tagToClosure tycon
(CmmReg (CmmLocal tag_reg))))
performReturn emitReturnInstr
where
\begin{code}
cgExpr (StgCase expr live_vars save_vars bndr srt alt_type alts)
- = cgCase expr live_vars save_vars bndr srt alt_type alts
+ = setSRT srt $ cgCase expr live_vars save_vars bndr alt_type alts
\end{code}
; returnFC (name, idinfo) }
cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
- = do this_pkg <- getThisPackage
- mkRhsClosure this_pkg name cc bi srt fvs upd_flag args body
+ = setSRT srt $ mkRhsClosure name cc bi fvs upd_flag args body
\end{code}
mkRhsClosure looks for two special forms of the right-hand side:
\begin{code}
-mkRhsClosure this_pkg bndr cc bi srt
+mkRhsClosure bndr cc bi
[the_fv] -- Just one free var
upd_flag -- Updatable thunk
[] -- A thunk
body@(StgCase (StgApp scrutinee [{-no args-}])
- _ _ _ _ -- ignore uniq, etc.
+ _ _ _ srt -- ignore uniq, etc.
(AlgAlt tycon)
[(DataAlt con, params, use_mask,
(StgApp selectee [{-no args-}]))])
-- 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]
+ setSRT srt $ cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
where
lf_info = mkSelectorLFInfo bndr offset_into_int
(isUpdatable upd_flag)
- (_, params_w_offsets) = layOutDynConstr this_pkg con (addIdReps params)
+ (_, params_w_offsets) = layOutDynConstr con (addIdReps params)
-- Just want the layout
maybe_offset = assocMaybe params_w_offsets selectee
Just the_offset = maybe_offset
for semi-obvious reasons.
\begin{code}
-mkRhsClosure this_pkg bndr cc bi srt
+mkRhsClosure bndr cc bi
fvs
upd_flag
[] -- No args; a thunk
The default case
~~~~~~~~~~~~~~~~
\begin{code}
-mkRhsClosure this_pkg bndr cc bi srt fvs upd_flag args body
- = cgRhsClosure bndr cc bi srt fvs upd_flag args body
+mkRhsClosure bndr cc bi fvs upd_flag args body
+ = cgRhsClosure bndr cc bi fvs upd_flag args body
\end{code}
-- 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
+ setSRT srt $ cgLetNoEscapeClosure binder cc bi 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
-- 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
(StgRhsCon cc con args)
- = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} NoSRT
+ = setSRT NoSRT $ cgLetNoEscapeClosure binder cc noBinderInfo{-safe-}
full_live_in_rhss rhs_eob_info maybe_cc_slot rec
[] --No args; the binder is data structure, not a function
(StgConApp con args)