optional<pair<expr, constraint_seq>> projection_converter::reduce_projection(expr const & t) {
projection_info const * info = is_projection(t);
if (!info)
return optional<pair<expr, constraint_seq>>();
buffer<expr> args;
get_app_args(t, args);
if (args.size() <= info->m_nparams) {
return optional<pair<expr, constraint_seq>>();
}
unsigned mkidx = info->m_nparams;
expr const & mk = args[mkidx];
pair<expr, constraint_seq> new_mk_cs = whnf(mk);
expr new_mk = new_mk_cs.first;
expr const & new_mk_fn = get_app_fn(new_mk);
if (!is_constant(new_mk_fn) || const_name(new_mk_fn) != info->m_constructor) {
return optional<pair<expr, constraint_seq>>();
}
buffer<expr> mk_args;
get_app_args(new_mk, mk_args);
unsigned i = info->m_nparams + info->m_i;
if (i >= mk_args.size()) {
return optional<pair<expr, constraint_seq>>();
}
expr r = mk_args[i];
r = mk_app(r, args.size() - mkidx - 1, args.data() + mkidx + 1);
return optional<pair<expr, constraint_seq>>(r, new_mk_cs.second);
}
/* Try to reduce cases_on (and nonrecursive recursor) application
if major became a constructor */
expr visit_cases_on_app(expr const & e_0) {
expr e = default_visit_app(e_0);
buffer<expr> args;
expr const & fn = get_app_args(e, args);
lean_assert(is_constant(fn));
bool is_cases_on = is_cases_on_recursor(env(), const_name(fn));
name const & rec_name = const_name(fn);
name const & I_name = rec_name.get_prefix();
unsigned nparams = *inductive::get_num_params(env(), I_name);
unsigned nindices = *inductive::get_num_indices(env(), I_name);
unsigned major_idx;
if (is_cases_on) {
major_idx = nparams + 1 + nindices;
} else {
major_idx = *inductive::get_elim_major_idx(env(), rec_name);
}
expr major = beta_reduce(args[major_idx]);
if (is_constructor_app(env(), major)) {
/* Major premise became a constructor. So, we should reduce. */
expr new_e = e;
if (is_cases_on) {
/* unfold cases_on */
if (auto r = unfold_term(env(), new_e))
new_e = *r;
else
return e;
}
/* reduce */
if (auto r = ctx().norm_ext(new_e))
return compiler_step_visitor::visit(beta_reduce(*r));
}
return e;
}
expr dsimplify_core_fn::visit_app(expr const & e) {
buffer<expr> args;
bool modified = false;
expr f = get_app_args(e, args);
unsigned i = 0;
if (!m_cfg.m_canonize_instances) {
fun_info info = get_fun_info(m_ctx, f, args.size());
for (param_info const & pinfo : info.get_params_info()) {
lean_assert(i < args.size());
expr new_a;
if (pinfo.is_inst_implicit()) {
new_a = m_defeq_canonizer.canonize(args[i], m_need_restart);
} else {
new_a = visit(args[i]);
}
if (new_a != args[i])
modified = true;
args[i] = new_a;
i++;
}
}
for (; i < args.size(); i++) {
expr new_a = visit(args[i]);
if (new_a != args[i])
modified = true;
args[i] = new_a;
}
if (modified)
return mk_app(f, args);
else
return e;
}
/** \brief Return true iff all recursive applications in \c e are structurally smaller than \c m_pattern. */
bool check_rhs(expr const & e) {
switch (e.kind()) {
case expr_kind::Var: case expr_kind::Meta:
case expr_kind::Local: case expr_kind::Constant:
case expr_kind::Sort:
return true;
case expr_kind::Macro:
for (unsigned i = 0; i < macro_num_args(e); i++)
if (!check_rhs(macro_arg(e, i)))
return false;
return true;
case expr_kind::App: {
buffer<expr> args;
expr const & fn = get_app_args(e, args);
if (!check_rhs(fn))
return false;
for (unsigned i = 0; i < args.size(); i++)
if (!check_rhs(args[i]))
return false;
if (is_local(fn) && mlocal_name(fn) == mlocal_name(m_fn)) {
/* recusive application */
if (m_arg_idx < args.size()) {
expr const & arg = args[m_arg_idx];
/* arg must be structurally smaller than m_pattern */
if (!is_lt(arg, m_pattern)) {
trace_struct_aux(tout() << "structural recursion on argument #" << (m_arg_idx+1)
<< " was not used "
<< "for '" << m_fn << "'\nargument #" << (m_arg_idx+1)
<< " in the application\n "
<< e << "\nis not structurally smaller than the one occurring in "
<< "the equation left-hand-side\n "
<< m_lhs << "\n";);
return false;
}
} else {
bool is_recursive_rec_app(environment const & env, expr const & e) {
buffer<expr> args;
name_generator ngen;
expr const & f = get_app_args(e, args);
if (!is_constant(f))
return false;
auto I_name = inductive::is_elim_rule(env, const_name(f));
if (!I_name || !is_recursive_datatype(env, *I_name) || is_inductive_predicate(env, *I_name))
return false;
unsigned nparams = *inductive::get_num_params(env, *I_name);
unsigned nminors = *inductive::get_num_minor_premises(env, *I_name);
unsigned ntypeformers = *inductive::get_num_type_formers(env, *I_name);
buffer<buffer<bool>> is_rec_arg;
get_rec_args(env, *I_name, is_rec_arg);
for (unsigned i = nparams + ntypeformers, j = 0; i < nparams + ntypeformers + nminors; i++, j++) {
buffer<bool> const & minor_is_rec_arg = is_rec_arg[j];
expr minor = args[i];
buffer<expr> minor_ctx;
expr minor_body = fun_to_telescope(ngen, minor, minor_ctx, optional<binder_info>());
unsigned sz = std::min(minor_is_rec_arg.size(), minor_ctx.size());
if (find(minor_body, [&](expr const & e, unsigned) {
if (!is_local(e))
return false;
for (unsigned k = 0; k < sz; k++) {
if (minor_is_rec_arg[k] && mlocal_name(e) == mlocal_name(minor_ctx[k]))
return true;
}
return false;
}))
return false;
}
return true;
}
optional<expr> projection_converter::is_stuck(expr const & e, type_checker & c) {
projection_info const * info = is_projection(e);
if (!info)
return default_converter::is_stuck(e, c);
buffer<expr> args;
get_app_args(e, args);
if (args.size() <= info->m_nparams)
return none_expr();
expr mk = whnf(args[info->m_nparams], c).first;
return c.is_stuck(mk);
}
// Check whether rhs is of the form (mvar l_1 ... l_n) where mvar is a metavariable,
// and l_i's are local constants, and mvar does not occur in found_mvars.
// If it is return true and update found_mvars
static bool is_valid_congr_hyp_rhs(expr const & rhs, name_set & found_mvars) {
buffer<expr> rhs_args;
expr const & rhs_fn = get_app_args(rhs, rhs_args);
if (!is_metavar(rhs_fn) || found_mvars.contains(mlocal_name(rhs_fn)))
return false;
for (expr const & arg : rhs_args)
if (!is_local(arg))
return false;
found_mvars.insert(mlocal_name(rhs_fn));
return true;
}
virtual optional<expr> expand(expr const & m, abstract_type_context & ctx) const {
check_macro(m);
expr const & s = macro_arg(m, 0);
expr new_s = ctx.whnf(s);
buffer<expr> c_args;
expr const & c = get_app_args(new_s, c_args);
if (is_constant(c) && const_name(c) == m_constructor_name && m_idx < c_args.size()) {
return some_expr(c_args[m_idx]);
} else {
// expand into recursor
expr s_type = ctx.whnf(ctx.infer(s));
buffer<expr> args;
expr const & I = get_app_args(s_type, args);
if (!is_constant(I) || length(m_ps) != length(const_levels(I)))
return none_expr();
expr r = instantiate_univ_params(m_val, m_ps, const_levels(I));
args.push_back(new_s);
return some(instantiate_rev(r, args.size(), args.data()));
}
}
static optional<pair<expr, expr>> apply_symmetry(environment const & env, old_local_context & ctx, type_checker_ptr & tc,
expr const & e, expr const & e_type, constraint_seq & cs, tag g) {
buffer<expr> args;
expr const & op = get_app_args(e_type, args);
if (is_constant(op)) {
if (auto info = get_symm_extra_info(env, const_name(op))) {
return mk_op(env, ctx, tc, info->m_name,
info->m_num_univs, info->m_num_args-1, {e}, cs, g);
}
}
return optional<pair<expr, expr>>();
}
unsigned abstract_expr_manager::hash(expr const & e) {
unsigned h;
switch (e.kind()) {
case expr_kind::Constant:
case expr_kind::Local:
case expr_kind::Meta:
case expr_kind::Sort:
case expr_kind::Var:
case expr_kind::Macro:
return e.hash();
case expr_kind::Lambda:
case expr_kind::Pi:
h = hash(binding_domain(e));
// Remark binding_domain(e) may contain de-bruijn variables.
// We can instantiate them eagerly as we do here, or lazily.
// The lazy approach is potentially more efficient, but we would have
// to use something more sophisticated than an instantiate_rev at expr_kind::App
m_locals.push_back(instantiate_rev(m_tctx.mk_tmp_local(binding_domain(e)), m_locals.size(), m_locals.data()));
h = ::lean::hash(h, hash(binding_body(e)));
m_locals.pop_back();
return h;
case expr_kind::Let:
// Let-expressions must be unfolded before invoking this method
lean_unreachable();
case expr_kind::App:
buffer<expr> args;
expr const & f = get_app_args(e, args);
unsigned prefix_sz = m_congr_lemma_manager.get_specialization_prefix_size(instantiate_rev(f, m_locals.size(), m_locals.data()), args.size());
expr new_f = e;
unsigned rest_sz = args.size() - prefix_sz;
for (unsigned i = 0; i < rest_sz; i++)
new_f = app_fn(new_f);
new_f = instantiate_rev(new_f, m_locals.size(), m_locals.data());
optional<congr_lemma> congr = m_congr_lemma_manager.mk_congr(new_f, rest_sz);
h = hash(new_f);
if (!congr) {
for (unsigned i = prefix_sz; i < args.size(); i++) {
h = ::lean::hash(h, hash(args[i]));
}
} else {
lean_assert(length(congr->get_arg_kinds()) == rest_sz);
unsigned i = prefix_sz;
for_each(congr->get_arg_kinds(), [&](congr_arg_kind const & c_kind) {
if (c_kind != congr_arg_kind::Cast) {
h = ::lean::hash(h, hash(args[i]));
}
i++;
});
}
return h;
}
lean_unreachable();
}
bool is_simp_relation(environment const & env, expr const & e, expr & rel, expr & lhs, expr & rhs) {
buffer<expr> args;
rel = get_app_args(e, args);
if (!is_constant(rel) || !is_simp_relation(env, const_name(rel)))
return false;
relation_info const * rel_info = get_relation_info(env, const_name(rel));
if (!rel_info || rel_info->get_lhs_pos() >= args.size() || rel_info->get_rhs_pos() >= args.size())
return false;
lhs = args[rel_info->get_lhs_pos()];
rhs = args[rel_info->get_rhs_pos()];
return true;
}
bool goal::validate_locals() const {
buffer<expr> locals;
get_app_args(m_meta, locals);
if (!::lean::validate_locals(m_type, locals.size(), locals.data()))
return false;
unsigned i = locals.size();
while (i > 0) {
--i;
if (!::lean::validate_locals(mlocal_type(locals[i]), i, locals.data()))
return false;
}
return true;
}
static optional<pair<expr, expr>> apply_subst(environment const & env, old_local_context & ctx,
type_checker_ptr & tc, expr const & e, expr const & e_type,
expr const & pred, constraint_seq & cs, tag g) {
buffer<expr> pred_args;
get_app_args(pred, pred_args);
unsigned npargs = pred_args.size();
if (npargs < 2)
return optional<pair<expr, expr>>();
buffer<expr> args;
expr const & op = get_app_args(e_type, args);
if (is_constant(op) && args.size() >= 2) {
if (auto sinfo = get_subst_extra_info(env, const_name(op))) {
if (auto rinfo = get_refl_extra_info(env, const_name(op))) {
if (auto refl_pair = mk_op(env, ctx, tc, rinfo->m_name, rinfo->m_num_univs,
rinfo->m_num_args-1, { pred_args[npargs-2] }, cs, g)) {
return mk_op(env, ctx, tc, sinfo->m_name, sinfo->m_num_univs,
sinfo->m_num_args-2, {e, refl_pair->first}, cs, g);
}
}
}
}
return optional<pair<expr, expr>>();
}
void visit_app(expr const & e) {
if (should_visit(e)) {
buffer<expr> args;
expr const & fn = get_app_args(e, args);
if (is_constant(fn) && is_inline(m_tc.env(), const_name(fn))) {
if (auto new_e = unfold_app(m_tc.env(), e)) {
visit(*new_e);
return;
}
}
visit(fn);
for (expr const & arg : args)
visit(arg);
}
}
virtual expr visit_app(expr const & e) override {
buffer<expr> args;
expr const & fn = get_app_args(e, args);
if (is_constant(fn)) {
name const & n = const_name(fn);
if (is_cases_on_recursor(env(), n)) {
return visit_cases_on(n, args);
} else if (inductive::is_intro_rule(env(), n)) {
return visit_constructor(n, args);
} else if (is_projection(env(), n)) {
return visit_projection(n, args);
}
}
return compiler_step_visitor::visit_app(e);
}
expr compiler_step_visitor::visit_app(expr const & e) {
buffer<expr> args;
expr const & fn = get_app_args(e, args);
expr new_fn = visit(fn);
bool modified = !is_eqp(fn, new_fn);
for (expr & arg : args) {
expr new_arg = visit(arg);
if (!is_eqp(new_arg, arg))
modified = true;
arg = new_arg;
}
if (!modified)
return e;
else
return copy_tag(e, mk_app(new_fn, args));
}
static bool is_num(expr const & e, bool first) {
buffer<expr> args;
expr const & f = get_app_args(e, args);
if (!is_constant(f))
return false;
if (const_name(f) == get_has_one_one_name())
return args.size() == 2;
else if (const_name(f) == get_has_zero_zero_name())
return first && args.size() == 2;
else if (const_name(f) == get_nat_zero_name())
return first && args.size() == 0;
else if (const_name(f) == get_bit0_name())
return args.size() == 3 && is_num(args[2], false);
else if (const_name(f) == get_bit1_name())
return args.size() == 4 && is_num(args[3], false);
return false;
}
bool to_string_core(expr const & e, std::string & r) {
if (e == *g_empty || e == *g_list_nil_char) {
return true;
} else if (is_string_macro(e)) {
r = to_string_macro(e).get_value();
return true;
} else {
buffer<expr> args;
expr const & fn = get_app_args(e, args);
if (fn == *g_str && args.size() == 2) {
return to_string_core(args[1], r) && append_char(args[0], r);
} else if (fn == *g_list_cons && args.size() == 3 && args[0] == *g_char) {
return to_string_core(args[2], r) && append_char(args[1], r);
} else {
return false;
}
}
}
bool is_cases_applicable(expr const & mvar, expr const & H) {
type_context ctx = mk_type_context_for(mvar);
expr t = whnf_inductive(ctx, ctx.infer(H));
buffer<expr> args;
expr const & fn = get_app_args(t, args);
if (!is_constant(fn))
return false;
if (!is_ginductive(m_env, const_name(fn)))
return false;
if (!m_env.find(name{const_name(fn), "cases_on"}) || !m_env.find(get_eq_name()))
return false;
if (!m_env.find(get_heq_name()))
return false;
init_inductive_info(const_name(fn));
if (args.size() != m_nindices + m_nparams)
return false;
lean_cases_trace(mvar, tout() << "inductive type: " << const_name(fn) <<
", num. params: " << m_nparams << ", num. indices: " << m_nindices << "\n";);
optional<char> to_char(expr const & e) {
buffer<expr> args;
expr const & fn = get_app_args(e, args);
if (fn == *g_fin_mk && args.size() == 3) {
if (auto n = to_num(args[1])) {
return optional<char>(n->get_unsigned_int());
} else {
return optional<char>();
}
} else if (fn == *g_char_of_nat && args.size() == 1) {
if (auto n = to_num(args[0])) {
return optional<char>(n->get_unsigned_int());
} else {
return optional<char>();
}
} else {
return optional<char>();
}
}
virtual expr visit_app(expr const & e) override {
if (auto r = expand_core(e)) {
return *r;
} else {
buffer<expr> args;
expr f = get_app_args(e, args);
bool modified = false;
for (unsigned i = 0; i < args.size(); i++) {
expr arg = args[i];
expr new_arg = visit(arg);
if (!is_eqp(arg, new_arg))
modified = true;
args[i] = new_arg;
}
if (!modified)
return e;
else
return mk_app(f, args);
}
}
unsigned light_lt_manager::get_weight_core(expr const & e) {
switch (e.kind()) {
case expr_kind::Var: case expr_kind::Constant: case expr_kind::Sort:
case expr_kind::Meta: case expr_kind::Local:
return 1;
case expr_kind::Lambda: case expr_kind::Pi:
return safe_add(1, safe_add(get_weight(binding_domain(e)), get_weight(binding_body(e))));
case expr_kind::Macro:
return safe_add(1, add_weight(macro_num_args(e), macro_args(e)));
case expr_kind::App:
buffer<expr> args;
expr fn = get_app_args(e, args);
if (is_constant(fn)) {
unsigned const * light_arg = m_lrs.find(const_name(fn));
if (light_arg && args.size() > *light_arg) return get_weight(args[*light_arg]);
}
return safe_add(1, safe_add(get_weight(app_fn(e)), get_weight(app_arg(e))));
}
lean_unreachable(); // LCOV_EXCL_LINE
}
virtual expr check_type(expr const & m, abstract_type_context & ctx, bool infer_only) const {
check_macro(m);
environment const & env = ctx.env();
expr s = macro_arg(m, 0);
expr s_t = ctx.whnf(ctx.check(s, infer_only));
buffer<expr> I_args;
expr const & I = get_app_args(s_t, I_args);
if (!is_constant(I)) {
// remark: this is not an issue since this macro should not be used during elaboration.
throw_kernel_exception(env, sstream() << "projection macros do not support arbitrary terms "
<< "containing metavariables yet (solution: use trust-level 0)", m);
}
if (length(const_levels(I)) != length(m_ps))
throw_kernel_exception(env, sstream() << "invalid projection application '" << m_proj_name
<< "', incorrect number of universe parameters", m);
expr t = instantiate_univ_params(m_type, m_ps, const_levels(I));
I_args.push_back(s);
return instantiate_rev(t, I_args.size(), I_args.data());
}
virtual expr visit_app(expr const & e) override {
buffer<expr> args;
expr const & fn = get_app_args(e, args);
for (expr & arg : args)
arg = visit(arg);
auto fnidx = get_fn_idx(fn);
if (!fnidx) return replace_visitor_with_tc::visit_app(e);
expr new_fn = m_ues.get_fn(*fnidx);
if (fn == new_fn) return replace_visitor_with_tc::visit_app(e);
unsigned arity = m_ues.get_arity_of(*fnidx);
if (args.size() < arity) {
expr new_e = m_ctx.eta_expand(e);
if (!is_lambda(new_e)) throw_ill_formed_eqns();
return visit(new_e);
}
expr new_fn_type = m_ctx.infer(new_fn);
expr sigma_type = binding_domain(new_fn_type);
expr arg = pack(0, arity, args, sigma_type);
expr r = mk_app(new_fn, arg);
return copy_tag(e, mk_app(r, args.size() - arity, args.data() + arity));
}
/* Return true iff v is of the form (g y_1 ... y_n) where
y_i is a constant or a variable.
Moreover, y_i's variables are pairwise distinct. */
bool is_simple_application(expr const & v) {
buffer<expr> ys;
buffer<bool> bitmap;
expr const & g = get_app_args(v, ys);
if (!is_constant(g) && !is_var(g))
return false;
for (expr const & y : ys) {
if (!is_var(y) && !is_constant(y))
return false;
if (is_var(y)) {
unsigned vidx = var_idx(y);
if (vidx >= bitmap.size())
bitmap.resize(vidx+1, false);
if (bitmap[vidx]) {
/* y_i's are not pairwise distinct */
return false;
}
bitmap[vidx] = true;
}
}
return true;
}
bool light_lt_manager::is_lt(expr const & a, expr const & b) {
if (is_eqp(a, b)) return false;
unsigned wa = get_weight(a);
unsigned wb = get_weight(b);
if (wa < wb) return true;
if (wa > wb) return false;
if (is_constant(get_app_fn(a))) {
unsigned const * light_arg = m_lrs.find(const_name(get_app_fn(a)));
if (light_arg) {
buffer<expr> args;
get_app_args(a, args);
if (args.size() > *light_arg) return is_lt(args[*light_arg], b);
}
}
if (is_constant(get_app_fn(b))) {
unsigned const * light_arg = m_lrs.find(const_name(get_app_fn(b)));
if (light_arg) {
buffer<expr> args;
get_app_args(b, args);
if (args.size() > *light_arg) return !is_lt(args[*light_arg], a);
}
}
if (a.kind() != b.kind()) return a.kind() < b.kind();
if (a == b) return false;
switch (a.kind()) {
case expr_kind::Var:
return var_idx(a) < var_idx(b);
case expr_kind::Constant:
if (const_name(a) != const_name(b))
return const_name(a) < const_name(b);
else
return ::lean::is_lt(const_levels(a), const_levels(b), false);
case expr_kind::App:
if (app_fn(a) != app_fn(b))
return is_lt(app_fn(a), app_fn(b));
else
return is_lt(app_arg(a), app_arg(b));
case expr_kind::Lambda: case expr_kind::Pi:
if (binding_domain(a) != binding_domain(b))
return is_lt(binding_domain(a), binding_domain(b));
else
return is_lt(binding_body(a), binding_body(b));
case expr_kind::Sort:
return ::lean::is_lt(sort_level(a), sort_level(b), false);
case expr_kind::Local: case expr_kind::Meta:
if (mlocal_name(a) != mlocal_name(b))
return mlocal_name(a) < mlocal_name(b);
else
return is_lt(mlocal_type(a), mlocal_type(b));
case expr_kind::Macro:
if (macro_def(a) != macro_def(b))
return macro_def(a) < macro_def(b);
if (macro_num_args(a) != macro_num_args(b))
return macro_num_args(a) < macro_num_args(b);
for (unsigned i = 0; i < macro_num_args(a); i++) {
if (macro_arg(a, i) != macro_arg(b, i))
return is_lt(macro_arg(a, i), macro_arg(b, i));
}
return false;
}
lean_unreachable(); // LCOV_EXCL_LINE
}
static environment mk_brec_on(environment const & env, name const & n, bool ind) {
if (!is_recursive_datatype(env, n))
return env;
if (is_inductive_predicate(env, n))
return env;
inductive::inductive_decls decls = *inductive::is_inductive_decl(env, n);
type_checker tc(env);
name_generator ngen;
unsigned nparams = std::get<1>(decls);
declaration ind_decl = env.get(n);
declaration rec_decl = env.get(inductive::get_elim_name(n));
// declaration below_decl = env.get(name(n, ind ? "ibelow" : "below"));
unsigned nindices = *inductive::get_num_indices(env, n);
unsigned nminors = *inductive::get_num_minor_premises(env, n);
unsigned ntypeformers = length(std::get<2>(decls));
level_param_names lps = rec_decl.get_univ_params();
bool is_reflexive = is_reflexive_datatype(tc, n);
level lvl = mk_param_univ(head(lps));
levels lvls = param_names_to_levels(tail(lps));
level rlvl;
level_param_names blps;
levels blvls; // universe level parameters of brec_on/binduction_on
// The arguments of brec_on (binduction_on) are the ones in the recursor - minor premises.
// The universe we map to is also different (l+1 for below of reflexive types) and (0 fo ibelow).
expr ref_type;
if (ind) {
// we are eliminating to Prop
blps = tail(lps);
blvls = lvls;
rlvl = mk_level_zero();
ref_type = instantiate_univ_param(rec_decl.get_type(), param_id(lvl), mk_level_zero());
} else if (is_reflexive) {
blps = lps;
blvls = cons(lvl, lvls);
rlvl = get_datatype_level(ind_decl.get_type());
// if rlvl is of the form (max 1 l), then rlvl <- l
if (is_max(rlvl) && is_one(max_lhs(rlvl)))
rlvl = max_rhs(rlvl);
rlvl = mk_max(mk_succ(lvl), rlvl);
// inner_prod, inner_prod_intro, pr1, pr2 do not use the same universe levels for
// reflective datatypes.
ref_type = instantiate_univ_param(rec_decl.get_type(), param_id(lvl), mk_succ(lvl));
} else {
// we can simplify the universe levels for non-reflexive datatypes
blps = lps;
blvls = cons(lvl, lvls);
rlvl = mk_max(mk_level_one(), lvl);
ref_type = rec_decl.get_type();
}
buffer<expr> ref_args;
to_telescope(ngen, ref_type, ref_args);
if (ref_args.size() != nparams + ntypeformers + nminors + nindices + 1)
throw_corrupted(n);
// args contains the brec_on/binduction_on arguments
buffer<expr> args;
buffer<name> typeformer_names;
// add parameters and typeformers
for (unsigned i = 0; i < nparams; i++)
args.push_back(ref_args[i]);
for (unsigned i = nparams; i < nparams + ntypeformers; i++) {
args.push_back(ref_args[i]);
typeformer_names.push_back(mlocal_name(ref_args[i]));
}
// add indices and major premise
for (unsigned i = nparams + ntypeformers + nminors; i < ref_args.size(); i++)
args.push_back(ref_args[i]);
// create below terms (one per datatype)
// (below.{lvls} params type-formers)
// Remark: it also creates the result type
buffer<expr> belows;
expr result_type;
unsigned k = 0;
for (auto const & decl : std::get<2>(decls)) {
name const & n1 = inductive::inductive_decl_name(decl);
if (n1 == n) {
result_type = ref_args[nparams + k];
for (unsigned i = nparams + ntypeformers + nminors; i < ref_args.size(); i++)
result_type = mk_app(result_type, ref_args[i]);
}
k++;
name bname = name(n1, ind ? "ibelow" : "below");
expr below = mk_constant(bname, blvls);
for (unsigned i = 0; i < nparams; i++)
below = mk_app(below, ref_args[i]);
for (unsigned i = nparams; i < nparams + ntypeformers; i++)
below = mk_app(below, ref_args[i]);
belows.push_back(below);
}
// create functionals (one for each type former)
// Pi idxs t, below idxs t -> C idxs t
buffer<expr> Fs;
name F_name("F");
for (unsigned i = nparams, j = 0; i < nparams + ntypeformers; i++, j++) {
expr const & C = ref_args[i];
buffer<expr> F_args;
to_telescope(ngen, mlocal_type(C), F_args);
expr F_result = mk_app(C, F_args);
expr F_below = mk_app(belows[j], F_args);
F_args.push_back(mk_local(ngen.next(), "f", F_below, binder_info()));
expr F_type = Pi(F_args, F_result);
expr F = mk_local(ngen.next(), F_name.append_after(j+1), F_type, binder_info());
Fs.push_back(F);
args.push_back(F);
}
// We define brec_on/binduction_on using the recursor for this type
levels rec_lvls = cons(rlvl, lvls);
expr rec = mk_constant(rec_decl.get_name(), rec_lvls);
// add parameters to rec
for (unsigned i = 0; i < nparams; i++)
rec = mk_app(rec, ref_args[i]);
// add type formers to rec
// Pi indices t, prod (C ... t) (below ... t)
for (unsigned i = nparams, j = 0; i < nparams + ntypeformers; i++, j++) {
expr const & C = ref_args[i];
buffer<expr> C_args;
to_telescope(ngen, mlocal_type(C), C_args);
expr C_t = mk_app(C, C_args);
expr below_t = mk_app(belows[j], C_args);
expr prod = mk_prod(tc, C_t, below_t, ind);
rec = mk_app(rec, Fun(C_args, prod));
}
// add minor premises to rec
for (unsigned i = nparams + ntypeformers, j = 0; i < nparams + ntypeformers + nminors; i++, j++) {
expr minor = ref_args[i];
expr minor_type = mlocal_type(minor);
buffer<expr> minor_args;
minor_type = to_telescope(ngen, minor_type, minor_args);
buffer<expr> pairs;
for (expr & minor_arg : minor_args) {
buffer<expr> minor_arg_args;
expr minor_arg_type = to_telescope(tc, mlocal_type(minor_arg), minor_arg_args);
if (auto k = is_typeformer_app(typeformer_names, minor_arg_type)) {
buffer<expr> C_args;
get_app_args(minor_arg_type, C_args);
expr new_minor_arg_type = mk_prod(tc, minor_arg_type, mk_app(belows[*k], C_args), ind);
minor_arg = update_mlocal(minor_arg, Pi(minor_arg_args, new_minor_arg_type));
if (minor_arg_args.empty()) {
pairs.push_back(minor_arg);
} else {
expr r = mk_app(minor_arg, minor_arg_args);
expr r_1 = Fun(minor_arg_args, mk_pr1(tc, r, ind));
expr r_2 = Fun(minor_arg_args, mk_pr2(tc, r, ind));
pairs.push_back(mk_pair(tc, r_1, r_2, ind));
}
}
}
expr b = foldr([&](expr const & a, expr const & b) { return mk_pair(tc, a, b, ind); },
[&]() { return mk_unit_mk(rlvl, ind); },
pairs.size(), pairs.data());
unsigned F_idx = *is_typeformer_app(typeformer_names, minor_type);
expr F = Fs[F_idx];
buffer<expr> F_args;
get_app_args(minor_type, F_args);
F_args.push_back(b);
expr new_arg = mk_pair(tc, mk_app(F, F_args), b, ind);
rec = mk_app(rec, Fun(minor_args, new_arg));
}
// add indices and major to rec
for (unsigned i = nparams + ntypeformers + nminors; i < ref_args.size(); i++)
rec = mk_app(rec, ref_args[i]);
name brec_on_name = name(n, ind ? "binduction_on" : "brec_on");
expr brec_on_type = Pi(args, result_type);
expr brec_on_value = Fun(args, mk_pr1(tc, rec, ind));
bool use_conv_opt = true;
declaration new_d = mk_definition(env, brec_on_name, blps, brec_on_type, brec_on_value,
use_conv_opt);
environment new_env = module::add(env, check(env, new_d));
new_env = set_reducible(new_env, brec_on_name, reducible_status::Reducible);
if (!ind)
new_env = add_unfold_hint(new_env, brec_on_name, nparams + nindices + ntypeformers);
return add_protected(new_env, brec_on_name);
}
expr goal::mk_meta(name const & n, expr const & type) const {
buffer<expr> locals;
expr this_mvar = get_app_args(m_meta, locals);
expr mvar = copy_tag(this_mvar, mk_metavar(n, Pi(locals, type)));
return copy_tag(m_meta, mk_app(mvar, locals));
}
expr goal::abstract(expr const & v) const {
buffer<expr> locals;
get_app_args(m_meta, locals);
return Fun(locals, v);
}
format goal::pp(formatter const & fmt, substitution const & s) const {
buffer<expr> hyps;
get_app_args(m_meta, hyps);
return format_goal(fmt, hyps, m_type, s);
}
