-exprIsValue other_expr
- | (Var fun, args) <- collectArgs other_expr,
- isDataConId fun || valArgCount args < idArity fun
- = check (idType fun) args
- | otherwise
- = False
+
+exprIsValue (Lit l) = True
+exprIsValue (Type ty) = True -- Types are honorary Values;
+ -- we don't mind copying them
+exprIsValue (Lam b e) = isRuntimeVar b || exprIsValue e
+exprIsValue (Note _ e) = exprIsValue e
+exprIsValue (App e (Type _)) = exprIsValue e
+exprIsValue (App e a) = app_is_value e [a]
+exprIsValue other = False
+
+-- There is at least one value argument
+app_is_value (Var fun) args
+ | isDataConWorkId fun -- Constructor apps are values
+ || idArity fun > valArgCount args -- Under-applied function
+ = check_args (idType fun) args
+app_is_value (App f a) as = app_is_value f (a:as)
+app_is_value other as = False
+
+ -- 'check_args' checks that unlifted-type args
+ -- are in fact guaranteed non-divergent
+check_args fun_ty [] = True
+check_args fun_ty (Type _ : args) = case splitForAllTy_maybe fun_ty of
+ Just (_, ty) -> check_args ty args
+check_args fun_ty (arg : args)
+ | isUnLiftedType arg_ty = exprOkForSpeculation arg
+ | otherwise = check_args res_ty args