+{-# 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
+
reps_n_amodes <- getArgAmodes stg_args
let
-- Get the *non-void* args, and jiggle them with shimForeignCall
reps_n_amodes <- getArgAmodes stg_args
let
-- Get the *non-void* args, and jiggle them with shimForeignCall
| (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
nonVoidArg rep]
| (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
nonVoidArg rep]
- arg_tmps <- mapM assignTemp arg_exprs
- let arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
+ arg_tmps <- sequence [ assignTemp arg
+ | (arg, stg_arg) <- arg_exprs]
+ let arg_hints = zipWith CmmHinted arg_tmps (map (typeForeignHint.stgArgType) stg_args)
{-
Now, allocate some result regs.
-}
(res_reps,res_regs,res_hints) <- newUnboxedTupleRegs res_ty
{-
Now, allocate some result regs.
-}
(res_reps,res_regs,res_hints) <- newUnboxedTupleRegs res_ty
- ccallReturnUnboxedTuple (zip res_reps (map CmmReg res_regs)) $
- emitForeignCall (zip res_regs res_hints) fcall
+ ccallReturnUnboxedTuple (zip res_reps (map (CmmReg . CmmLocal) res_regs)) $
+ 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,
arg_hints emptyVarSet{-no live vars-}
-- tagToEnum# is special: we need to pull the constructor out of the table,
; amode' <- assignTemp amode -- We're going to use it twice,
-- so save in a temp if non-trivial
; amode' <- assignTemp 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'))
- ; performReturn (emitAlgReturnCode tycon amode') }
+ ; stmtC (CmmAssign nodeReg (tagToClosure tycon amode'))
+ ; performReturn emitReturnInstr }
where
-- If you're reading this code in the attempt to figure
-- out why the compiler panic'ed here, it is probably because
where
-- If you're reading this code in the attempt to figure
-- out why the compiler panic'ed here, it is probably because
- = do cgPrimOp [dataReturnConvPrim (primRepToCgRep rep)]
- primop args emptyVarSet
- performReturn emitDirectReturnInstr
+ = do res <- newTemp (typeCmmType res_ty)
+ cgPrimOp [res] primop args emptyVarSet
+ performPrimReturn (primRepToCgRep rep) (CmmReg (CmmLocal res))
| ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
= do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
cgPrimOp regs primop args emptyVarSet{-no live vars-}
| ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
= do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
cgPrimOp regs primop args emptyVarSet{-no live vars-}
| ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
-- c.f. cgExpr (...TagToEnumOp...)
| ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
-- c.f. cgExpr (...TagToEnumOp...)
- stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon (CmmReg tag_reg)))
- performReturn (emitAlgReturnCode tycon (CmmReg tag_reg))
+ stmtC (CmmAssign nodeReg
+ (tagToClosure tycon
+ (CmmReg (CmmLocal tag_reg))))
+ performReturn emitReturnInstr
; returnFC (name, idinfo) }
cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
; returnFC (name, idinfo) }
cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
[the_fv] -- Just one free var
upd_flag -- Updatable thunk
[] -- A thunk
body@(StgCase (StgApp scrutinee [{-no args-}])
[the_fv] -- Just one free var
upd_flag -- Updatable thunk
[] -- A thunk
body@(StgCase (StgApp scrutinee [{-no args-}])
(AlgAlt tycon)
[(DataAlt con, params, use_mask,
(StgApp selectee [{-no args-}]))])
(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.
-- 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.
-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
-- case upd_flag of
-- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
-- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
-- case upd_flag of
-- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
-- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
maybe_cc_slot rec args body
-- For a constructor RHS we want to generate a single chunk of code which
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)
-- 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)
full_live_in_rhss rhs_eob_info maybe_cc_slot rec
[] --No args; the binder is data structure, not a function
(StgConApp con args)
full_live_in_rhss rhs_eob_info maybe_cc_slot rec
[] --No args; the binder is data structure, not a function
(StgConApp con args)
- (reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args,
+ (reps,hints) = unzip [ (rep, typeForeignHint ty) | ty <- ty_args,