-getContArgs :: SwitchChecker
- -> OutId -> SimplCont
- -> ([(InExpr, Maybe SimplEnv, Bool)], -- Arguments; the Bool is true for strict args
- SimplCont) -- Remaining continuation
--- getContArgs id k = (args, k', inl)
--- args are the leading ApplyTo items in k
--- (i.e. outermost comes first)
--- augmented with demand info from the functionn
-getContArgs chkr fun orig_cont
- = let
- -- Ignore strictness info if the no-case-of-case
- -- flag is on. Strictness changes evaluation order
- -- and that can change full laziness
- stricts | switchIsOn chkr NoCaseOfCase = vanilla_stricts
- | otherwise = computed_stricts
- in
- go [] stricts orig_cont
- where
- ----------------------------
-
- -- Type argument
- go acc ss (ApplyTo _ arg@(Type _) se cont)
- = go ((arg,se,False) : acc) ss cont
- -- NB: don't bother to instantiate the function type
-
- -- Value argument
- go acc (s:ss) (ApplyTo _ arg se cont)
- = go ((arg,se,s) : acc) ss cont
-
- -- We're run out of arguments, or else we've run out of demands
- -- The latter only happens if the result is guaranteed bottom
- -- This is the case for
- -- * case (error "hello") of { ... }
- -- * (error "Hello") arg
- -- * f (error "Hello") where f is strict
- -- etc
- -- Then, especially in the first of these cases, we'd like to discard
- -- the continuation, leaving just the bottoming expression. But the
- -- type might not be right, so we may have to add a coerce.
-
- go acc ss cont
- | null ss && discardableCont cont = (args, discardCont hole_ty cont)
- | otherwise = (args, cont)
- where
- args = reverse acc
- hole_ty = applyTypeToArgs (Var fun) (idType fun)
- [substExpr_mb se arg | (arg,se,_) <- args]
- substExpr_mb Nothing arg = arg
- substExpr_mb (Just se) arg = substExpr se arg
-
- ----------------------------
- vanilla_stricts, computed_stricts :: [Bool]
- vanilla_stricts = repeat False
- computed_stricts = zipWith (||) fun_stricts arg_stricts
-
- ----------------------------
- (val_arg_tys, res_ty) = splitFunTys (dropForAlls (idType fun))
- arg_stricts = map isStrictType val_arg_tys ++ repeat False
- -- These argument types are used as a cheap and cheerful way to find
- -- unboxed arguments, which must be strict. But it's an InType
- -- and so there might be a type variable where we expect a function
- -- type (the substitution hasn't happened yet). And we don't bother
- -- doing the type applications for a polymorphic function.
- -- Hence the splitFunTys*IgnoringForAlls*
-
- ----------------------------
- -- If fun_stricts is finite, it means the function returns bottom
- -- after that number of value args have been consumed
- -- Otherwise it's infinite, extended with False
- fun_stricts
- = case splitStrictSig (idNewStrictness fun) of
- (demands, result_info)
- | not (demands `lengthExceeds` countValArgs orig_cont)
- -> -- Enough args, use the strictness given.
- -- For bottoming functions we used to pretend that the arg
- -- is lazy, so that we don't treat the arg as an
- -- interesting context. This avoids substituting
- -- top-level bindings for (say) strings into
- -- calls to error. But now we are more careful about
- -- inlining lone variables, so its ok (see SimplUtils.analyseCont)
- if isBotRes result_info then
- map isStrictDmd demands -- Finite => result is bottom
- else
- map isStrictDmd demands ++ vanilla_stricts
-
- other -> vanilla_stricts -- Not enough args, or no strictness
-
--------------------
projects / ghc-hetmet.git / blobdiff