- (binder_args_pairs, leftover_binders, leftover_args) = collect_val_args binder args
-
- env_for_enough_args = extendIdEnvWithAtomList env binder_args_pairs
-
- env_for_too_few_args = extendIdEnvWithAtomList env zapped_binder_args_pairs
-
- -- Since there aren't enough args the binders we are cancelling with
- -- the args supplied are, in effect, ocurring inside a lambda.
- -- So we modify their occurrence info to reflect this fact.
- -- Example: (\ x y z -> e) p q
- -- ==> (\z -> e[p/x, q/y])
- -- but we should behave as if x and y are marked "inside lambda".
- -- The occurrence analyser does not mark them so itself because then we
- -- do badly on the very common case of saturated lambdas applications:
- -- (\ x y z -> e) p q r
- -- ==> e[p/x, q/y, r/z]
- --
- zapped_binder_args_pairs = [ ((id, markDangerousToDup occ_info), arg)
- | ((id, occ_info), arg) <- binder_args_pairs ]
-
- collect_val_args :: InBinder -- Binder
- -> [OutArg] -- Arguments
- -> ([(InBinder,OutArg)], -- Binder,arg pairs (ToDo: a maybe?)
- [InBinder], -- Leftover binders (ToDo: a maybe)
- [OutArg]) -- Leftover args
-
- -- collect_val_args strips off the leading ValArgs from
- -- the current arg list, returning them along with the
- -- depleted list
- collect_val_args binder [] = ([], [binder], [])
- collect_val_args binder (arg : args) | isValArg arg
- = ([(binder,arg)], [], args)
-
-#ifdef DEBUG
- collect_val_args _ (other_val_arg : _) = panic "collect_val_args"
- -- TyArg should never meet a Lam
-#endif
+ go n env (Lam (ValBinder binder) body) (val_arg : args)
+ | isValArg val_arg -- The lambda has an argument
+ = tick BetaReduction `thenSmpl_`
+ go (n+1) (extendIdEnvWithAtom env binder val_arg) body args
+
+ go n env expr@(Lam (ValBinder binder) body) args
+ -- The lambda is un-saturated, so we must zap the occurrence info
+ -- on the arguments we've already beta-reduced into the body of the lambda
+ = ASSERT( null args ) -- Value lambda must match value argument!
+ let
+ new_env = markDangerousOccs env (take n orig_args)
+ in
+ simplValLam new_env expr 0 {- Guaranteed applied to at least 0 args! -}
+
+ go n env non_val_lam_expr args -- The lambda had enough arguments
+ = simplExpr env non_val_lam_expr args