import IdInfo ( vanillaIdInfo )
import DataCon ( splitProductType_maybe, splitProductType )
import NewDemand ( Demand(..), DmdResult(..), Demands(..) )
-import MkId ( realWorldPrimId, voidArgId, eRROR_CSTRING_ID )
+import MkId ( realWorldPrimId, voidArgId, mkRuntimeErrorApp, rUNTIME_ERROR_ID )
import TysWiredIn ( tupleCon )
import Type ( Type, isUnLiftedType, mkFunTys,
splitForAllTys, splitFunTys, splitNewType_maybe, isAlgType
)
-import Literal ( Literal(MachStr) )
import BasicTypes ( Boxity(..) )
import Var ( Var, isId )
import UniqSupply ( returnUs, thenUs, getUniquesUs, UniqSM )
-import Util ( zipWithEqual )
+import Util ( zipWithEqual, notNull )
import Outputable
import List ( zipWith4 )
\end{code}
work_fn_args . Note (Coerce rep_ty fun_ty),
res_ty)
- | not (null demands)
+ | notNull demands
= getUniquesUs `thenUs` \ wrap_uniqs ->
let
- (tyvars, tau) = splitForAllTys fun_ty
- (arg_tys, body_ty) = splitFunTys tau
+ (tyvars, tau) = splitForAllTys fun_ty
+ (arg_tys, body_ty) = splitFunTys tau
n_demands = length demands
n_arg_tys = length arg_tys
val_args = zipWith4 mk_wrap_arg wrap_uniqs arg_tys demands one_shots
wrap_args = tyvars ++ val_args
in
-{- ASSERT( not (null tyvars) || not (null arg_tys) ) -}
+{- ASSERT( notNull tyvars || notNull arg_tys ) -}
if (null tyvars) && (null arg_tys) then
pprTrace "mkWWargs" (ppr fun_ty $$ ppr demands)
returnUs ([], id, id, fun_ty)
applyToVars vars fn = mkVarApps fn vars
mk_wrap_arg uniq ty dmd one_shot
- = set_one_shot one_shot (setIdNewDemandInfo (mkSysLocal SLIT("w") uniq ty) dmd)
+ = set_one_shot one_shot (setIdNewDemandInfo (mkSysLocal FSLIT("w") uniq ty) dmd)
where
set_one_shot True id = setOneShotLambda id
set_one_shot False id = id
= panic "WwLib: haven't done mk_absent_let for primitives yet"
where
arg_ty = idType arg
--- abs_rhs = mkTyApps (Var aBSENT_ERROR_ID) [arg_ty]
- abs_rhs = mkApps (Var eRROR_CSTRING_ID) [Type arg_ty, Lit (MachStr (_PK_ msg))]
+ abs_rhs = mkRuntimeErrorApp rUNTIME_ERROR_ID arg_ty msg
msg = "Oops! Entered absent arg " ++ showSDocDebug (ppr arg <+> ppr (idType arg))
mk_unpk_case arg unpk_args boxing_con boxing_tycon body
-- like (x+y) `seq` ....
sanitiseCaseBndr id = id `setIdInfo` vanillaIdInfo
-mk_ww_local uniq ty = mkSysLocal SLIT("ww") uniq ty
+mk_ww_local uniq ty = mkSysLocal FSLIT("ww") uniq ty
\end{code}