import CmdLineOpts ( opt_AllStrict, opt_NumbersStrict )
import CoreSyn
import CoreUnfold ( Unfolding(..) )
+import PrimOp ( primOpStrictness )
import Id ( Id, idType, getIdStrictness, getIdUnfolding )
import Const ( Con(..) )
import DataCon ( dataConTyCon, dataConArgTys )
= -- Literals terminate (strictness) and are not poison (absence)
AbsTop
-absEval anal (Con (PrimOp _) args) env
- = -- PrimOps evaluate all their arguments
- if any anyBot [absEval anal arg env | arg <- args]
+absEval anal (Con (PrimOp op) args) env
+ = -- Not all PrimOps evaluate all their arguments
+ if or (zipWith (check_arg anal)
+ [absEval anal arg env | arg <- args]
+ arg_demands)
then AbsBot
- else AbsTop
+ else case anal of
+ StrAnal | result_bot -> AbsBot
+ other -> AbsTop
+ where
+ (arg_demands, result_bot) = primOpStrictness op
+ check_arg StrAnal arg dmd = evalStrictness dmd arg
+ check_arg AbsAnal arg dmd = evalAbsence dmd arg
absEval anal (Con (DataCon con) args) env
| isProductTyCon (dataConTyCon con)
See notes on @addStrictnessInfoToId@.
\begin{code}
-findStrictness :: [Type] -- Types of args in which strictness is wanted
- -> AbsVal -- Abstract strictness value of function
- -> AbsVal -- Abstract absence value of function
- -> [Demand] -- Resulting strictness annotation
+findStrictness :: [Type] -- Types of args in which strictness is wanted
+ -> AbsVal -- Abstract strictness value of function
+ -> AbsVal -- Abstract absence value of function
+ -> ([Demand], Bool) -- Resulting strictness annotation
findStrictness tys str_val abs_val
- = map find_str tys_w_index
+ = (map find_str tys_w_index, isBot (foldl (absApply StrAnal) str_val all_tops))
where
tys_w_index = tys `zip` [1..]
mk_arg val n (_,m) | m==n = val
| otherwise = AbsTop
+
+ all_tops = [AbsTop | _ <- tys]
\end{code}