--- Preparing arguments for a call
-
-prepareArgs :: Bool -- True if the no-case-of-case switch is on
- -> OutId -> SimplCont
- -> ([OutExpr] -> SimplCont -> SimplM OutExprStuff)
- -> SimplM OutExprStuff
-prepareArgs no_case_of_case fun orig_cont thing_inside
- = go [] demands orig_fun_ty orig_cont
- where
- orig_fun_ty = idType fun
- is_data_con = isDataConId fun
-
- (demands, result_bot)
- | no_case_of_case = ([], False) -- Ignore strictness info if the no-case-of-case
- -- flag is on. Strictness changes evaluation order
- -- and that can change full laziness
- | otherwise
- = case idStrictness fun of
- StrictnessInfo demands result_bot
- | 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)
- (demands, result_bot)
-
- other -> ([], False) -- Not enough args, or no strictness
-
- -- Main game plan: loop through the arguments, simplifying
- -- each of them in turn. We carry with us a list of demands,
- -- and the type of the function-applied-to-earlier-args
-
- -- We've run out of demands, and the result is now bottom
- -- This deals with
- -- * case (error "hello") of { ... }
- -- * (error "Hello") arg
- -- * f (error "Hello") where f is strict
- -- etc
- go acc [] fun_ty cont
- | result_bot
- = tick_case_of_error cont `thenSmpl_`
- thing_inside (reverse acc) (discardCont cont)
-
- -- Type argument
- go acc ds fun_ty (ApplyTo _ arg@(Type ty_arg) se cont)
- = simplTyArg ty_arg se `thenSmpl` \ new_ty_arg ->
- go (Type new_ty_arg : acc) ds (applyTy fun_ty new_ty_arg) cont
-
- -- Value argument
- go acc ds fun_ty (ApplyTo _ val_arg se cont)
- | not is_data_con -- Function isn't a data constructor
- = simplValArg arg_ty dem val_arg se (contResultType cont) $ \ new_arg ->
- go (new_arg : acc) ds' res_ty cont
-
- | exprIsTrivial val_arg -- Function is a data contstructor, arg is trivial
- = getInScope `thenSmpl` \ in_scope ->
- let
- new_arg = substExpr (mkSubst in_scope se) val_arg
- -- Simplify the RHS with inlining switched off, so that
- -- only absolutely essential things will happen.
+-- Simplifying the arguments of a call
+
+simplifyArgs :: Bool -- It's a data constructor
+ -> [(InExpr, SubstEnv, Bool)] -- Details of the arguments
+ -> OutType -- Type of the continuation
+ -> ([OutExpr] -> SimplM OutExprStuff)
+ -> SimplM OutExprStuff
+
+-- Simplify the arguments to a call.
+-- This part of the simplifier may break the no-shadowing invariant
+-- Consider
+-- f (...(\a -> e)...) (case y of (a,b) -> e')
+-- where f is strict in its second arg
+-- If we simplify the innermost one first we get (...(\a -> e)...)
+-- Simplifying the second arg makes us float the case out, so we end up with
+-- case y of (a,b) -> f (...(\a -> e)...) e'
+-- So the output does not have the no-shadowing invariant. However, there is
+-- no danger of getting name-capture, because when the first arg was simplified
+-- we used an in-scope set that at least mentioned all the variables free in its
+-- static environment, and that is enough.
+--
+-- We can't just do innermost first, or we'd end up with a dual problem:
+-- case x of (a,b) -> f e (...(\a -> e')...)
+--
+-- I spent hours trying to recover the no-shadowing invariant, but I just could
+-- not think of an elegant way to do it. The simplifier is already knee-deep in
+-- continuations. We have to keep the right in-scope set around; AND we have
+-- to get the effect that finding (error "foo") in a strict arg position will
+-- discard the entire application and replace it with (error "foo"). Getting
+-- all this at once is TOO HARD!
+
+simplifyArgs is_data_con args cont_ty thing_inside
+ | not is_data_con
+ = go args thing_inside
+
+ | otherwise -- It's a data constructor, so we want
+ -- to switch off inlining in the arguments
projects / ghc-hetmet.git / blobdiff