/* Given a cases_on application, distribute extra arguments over minor premisses.
cases_on major minor_1 ... minor_n a_1 ... a_n
We apply a similar transformation at erase_irrelevant, but its effect can be undone
in subsequent compilation steps.
*/
void distribute_extra_args_over_minors(name const & I_name, buffer<name> const & cnames, buffer<expr> & args) {
lean_assert(args.size() > cnames.size() + 1);
unsigned nparams = *inductive::get_num_params(env(), I_name);
for (unsigned i = 0; i < cnames.size(); i++) {
unsigned carity = get_constructor_arity(env(), cnames[i]);
unsigned data_sz = carity - nparams;
type_context::tmp_locals locals(ctx());
expr new_minor = args[i+1];
for (unsigned j = 0; j < data_sz; j++) {
if (!is_lambda(new_minor))
throw exception("unexpected occurrence of 'cases_on' expression, "
"the minor premise is expected to be a lambda-expression");
expr local = locals.push_local_from_binding(new_minor);
new_minor = instantiate(binding_body(new_minor), local);
}
new_minor = beta_reduce(mk_app(new_minor, args.size() - cnames.size() - 1, args.data() + cnames.size() + 1));
args[i+1] = locals.mk_lambda(new_minor);
}
args.shrink(cnames.size() + 1);
}
/**
\brief Given a sequence metas: <tt>(?m_1 ...) (?m_2 ... ) ... (?m_k ...)</tt>,
we say ?m_i is "redundant" if it occurs in the type of some ?m_j.
This procedure removes from metas any redundant element.
*/
static void remove_redundant_metas(buffer<expr> & metas) {
buffer<expr> mvars;
for (expr const & m : metas)
mvars.push_back(get_app_fn(m));
unsigned k = 0;
for (unsigned i = 0; i < metas.size(); i++) {
bool found = false;
for (unsigned j = 0; j < metas.size(); j++) {
if (j != i) {
if (occurs(mvars[i], mlocal_type(mvars[j]))) {
found = true;
break;
}
}
}
if (!found) {
metas[k] = metas[i];
k++;
}
}
metas.shrink(k);
}
