import CostCentre ( noCCS )
import VarSet
import VarEnv
-import DataCon ( dataConWrapId )
import Maybes ( maybeToBool )
import Name ( getOccName, isExternalName, isDllName )
import OccName ( occNameUserString )
-import BasicTypes ( TopLevelFlag(..), isNotTopLevel, Arity )
+import BasicTypes ( Arity )
import CmdLineOpts ( DynFlags, opt_RuntimeTypes )
import FastTypes hiding ( fastOr )
import Util ( listLengthCmp, mapAndUnzip )
res_ty = exprType (mkApps (Var f) args)
app = case globalIdDetails f of
- DataConId dc | saturated -> StgConApp dc args'
- PrimOpId op -> ASSERT( saturated )
- StgOpApp (StgPrimOp op) args' res_ty
- FCallId call -> ASSERT( saturated )
- StgOpApp (StgFCallOp call (idUnique f)) args' res_ty
- _other -> StgApp f args'
+ DataConWorkId dc | saturated -> StgConApp dc args'
+ PrimOpId op -> ASSERT( saturated )
+ StgOpApp (StgPrimOp op) args' res_ty
+ FCallId call -> ASSERT( saturated )
+ StgOpApp (StgFCallOp call (idUnique f)) args' res_ty
+ _other -> StgApp f args'
in
returnLne (
fvs = args_fvs `unionFVInfo` arg_fvs
stg_arg = case arg' of
StgApp v [] -> StgVarArg v
- StgConApp con [] -> StgVarArg (dataConWrapId con)
+ StgConApp con [] -> StgVarArg (dataConWorkId con)
StgLit lit -> StgLitArg lit
_ -> pprPanic "coreToStgArgs" (ppr arg)
in
(getFVs rhs_fvs)
upd_flag [] rhs
where
+ upd_flag = Updatable
+ {-
+ SDM: disabled. Eval/Apply can't handle functions with arity zero very
+ well; and making these into simple non-updatable thunks breaks other
+ assumptions (namely that they will be entered only once).
+
upd_flag | isPAP env rhs = ReEntrant
| otherwise = Updatable
+ -}
+
{- ToDo:
upd = if isOnceDem dem
then (if isNotTop toplev
idAppIsNonUpd :: IdEnv HowBound -> Id -> Int -> [CoreExpr] -> Bool
idAppIsNonUpd p id n_val_args args
- | Just con <- isDataConId_maybe id = not (isCrossDllConApp con args)
- | otherwise = n_val_args < stgArity id (lookupBinding p id)
+ | Just con <- isDataConWorkId_maybe id = not (isCrossDllConApp con args)
+ | otherwise = False -- SDM: disbled. See comment with isPAP above.
+ -- n_val_args < stgArity id (lookupBinding p id)
stgArity :: Id -> HowBound -> Arity
stgArity f (LetBound _ arity) = arity