%
\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"
import CgUtils
import ClosureInfo
import Cmm
-import MachOp
+import CmmUtils
import VarSet
import Literal
import PrimOp
import ListSetOps
import BasicTypes
import Util
+import FastString
import Outputable
\end{code}
| (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
nonVoidArg rep]
- arg_tmps <- sequence [
- if isFollowableArg (typeCgRep (stgArgType stg_arg))
- then assignPtrTemp arg
- else assignNonPtrTemp arg
- | (arg, stg_arg) <- 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
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,
cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
= ASSERT(isEnumerationTyCon tycon)
do { (rep,amode) <- getArgAmode arg
- ; amode' <- if isFollowableArg rep
- then assignPtrTemp amode
- else assignNonPtrTemp amode
- -- We're going to use it twice,
+ ; 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'))
+ ; stmtC (CmmAssign nodeReg (tagToClosure tycon amode'))
; performReturn emitReturnInstr }
where
-- If you're reading this code in the attempt to figure
performReturn emitReturnInstr
| ReturnsPrim rep <- result_info
- = do res <- if isFollowableArg (typeCgRep res_ty)
- then newPtrTemp (argMachRep (typeCgRep res_ty))
- else newNonPtrTemp (argMachRep (typeCgRep res_ty))
+ = do res <- newTemp (typeCmmType res_ty)
cgPrimOp [res] primop args emptyVarSet
performPrimReturn (primRepToCgRep rep) (CmmReg (CmmLocal res))
| ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
-- c.f. cgExpr (...TagToEnumOp...)
- = do tag_reg <- if isFollowableArg (typeCgRep res_ty)
- then newPtrTemp wordRep
- else newNonPtrTemp wordRep
- this_pkg <- getThisPackage
+ = do tag_reg <- newTemp bWord -- The tag is a word
cgPrimOp [tag_reg] primop args emptyVarSet
stmtC (CmmAssign nodeReg
- (tagToClosure this_pkg tycon
+ (tagToClosure tycon
(CmmReg (CmmLocal tag_reg))))
performReturn emitReturnInstr
where
; returnFC (name, idinfo) }
cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
- = do this_pkg <- getThisPackage
- setSRT srt $ mkRhsClosure this_pkg name cc bi 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
+mkRhsClosure bndr cc bi
[the_fv] -- Just one free var
upd_flag -- Updatable thunk
[] -- A thunk
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
+mkRhsClosure bndr cc bi
fvs
upd_flag
[] -- No args; a thunk
The default case
~~~~~~~~~~~~~~~~
\begin{code}
-mkRhsClosure this_pkg bndr cc bi 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}
Little helper for primitives that return unboxed tuples.
\begin{code}
-newUnboxedTupleRegs :: Type -> FCode ([CgRep], [LocalReg], [MachHint])
+newUnboxedTupleRegs :: Type -> FCode ([CgRep], [LocalReg], [ForeignHint])
newUnboxedTupleRegs res_ty =
let
ty_args = tyConAppArgs (repType res_ty)
- (reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args,
+ (reps,hints) = unzip [ (rep, typeForeignHint ty) | ty <- ty_args,
let rep = typeCgRep ty,
nonVoidArg rep ]
- make_new_temp rep = if isFollowableArg rep
- then newPtrTemp (argMachRep rep)
- else newNonPtrTemp (argMachRep rep)
+ make_new_temp rep = newTemp (argMachRep rep)
in do
regs <- mapM make_new_temp reps
return (reps,regs,hints)