bool match_pattern(type_checker & tc, expr const & pattern, declaration const & d, unsigned max_steps, bool cheap) { name_generator ngen = tc.mk_ngen(); buffer<level> ls; unsigned num_ls = d.get_num_univ_params(); for (unsigned i = 0; i < num_ls; i++) ls.push_back(mk_meta_univ(ngen.next())); expr dt = instantiate_type_univ_params(d, to_list(ls.begin(), ls.end())); unsigned num_e = get_expect_num_args(tc, pattern); unsigned num_d = get_expect_num_args(tc, dt); if (num_e > num_d) return false; for (unsigned i = 0; i < num_d - num_e; i++) { dt = tc.whnf(dt).first; expr local = mk_local(ngen.next(), binding_domain(dt)); dt = instantiate(binding_body(dt), local); } try { unifier_config cfg; cfg.m_max_steps = max_steps; cfg.m_kind = cheap ? unifier_kind::Cheap : unifier_kind::Liberal; cfg.m_ignore_context_check = true; auto r = unify(tc.env(), pattern, dt, tc.mk_ngen(), substitution(), cfg); return static_cast<bool>(r.pull()); } catch (exception&) { return false; } }
static optional<pair<expr, expr>> mk_op(environment const & env, old_local_context & ctx, type_checker_ptr & tc, name const & op, unsigned nunivs, unsigned nargs, std::initializer_list<expr> const & explicit_args, constraint_seq & cs, tag g) { levels lvls; for (unsigned i = 0; i < nunivs; i++) lvls = levels(mk_meta_univ(mk_fresh_name()), lvls); expr c = mk_constant(op, lvls); expr op_type = instantiate_type_univ_params(env.get(op), lvls); buffer<expr> args; for (unsigned i = 0; i < nargs; i++) { if (!is_pi(op_type)) return optional<pair<expr, expr>>(); expr arg = ctx.mk_meta(some_expr(binding_domain(op_type)), g); args.push_back(arg); op_type = instantiate(binding_body(op_type), arg); } expr r = mk_app(c, args, g); for (expr const & explicit_arg : explicit_args) { if (!is_pi(op_type)) return optional<pair<expr, expr>>(); r = mk_app(r, explicit_arg); expr type = tc->infer(explicit_arg, cs); justification j = mk_app_justification(r, op_type, explicit_arg, type); if (!tc->is_def_eq(binding_domain(op_type), type, j, cs)) return optional<pair<expr, expr>>(); op_type = instantiate(binding_body(op_type), explicit_arg); } return some(mk_pair(r, op_type)); }
static simp_rule_sets add_core(type_checker & tc, simp_rule_sets const & s, name const & cname) { declaration const & d = tc.env().get(cname); buffer<level> us; unsigned num_univs = d.get_num_univ_params(); for (unsigned i = 0; i < num_univs; i++) { us.push_back(mk_meta_univ(name(*g_prefix, i))); } levels ls = to_list(us); expr e = instantiate_type_univ_params(d, ls); expr h = mk_constant(cname, ls); return add_core(tc, s, cname, ls, e, h); }
optional<constraints> try_instance(name const & inst) { environment const & env = m_C->env(); if (auto decl = env.find(inst)) { name_generator & ngen = m_C->m_ngen; buffer<level> ls_buffer; unsigned num_univ_ps = decl->get_num_univ_params(); for (unsigned i = 0; i < num_univ_ps; i++) ls_buffer.push_back(mk_meta_univ(ngen.next())); levels ls = to_list(ls_buffer.begin(), ls_buffer.end()); expr inst_cnst = copy_tag(m_meta, mk_constant(inst, ls)); expr inst_type = instantiate_type_univ_params(*decl, ls); return try_instance(inst_cnst, inst_type); } else { return optional<constraints>(); } }
level mk_idx_metauniv(unsigned i) { return mk_meta_univ(name(*g_tmp_prefix, i)); }
vm_obj level_meta(vm_obj const & n) { return to_obj(mk_meta_univ(to_name(n))); }
void add_congr_core(environment const & env, simp_rule_sets & s, name const & n) { declaration const & d = env.get(n); type_checker tc(env); buffer<level> us; unsigned num_univs = d.get_num_univ_params(); for (unsigned i = 0; i < num_univs; i++) { us.push_back(mk_meta_univ(name(*g_prefix, i))); } levels ls = to_list(us); expr pr = mk_constant(n, ls); expr e = instantiate_type_univ_params(d, ls); buffer<bool> explicit_args; buffer<expr> metas; unsigned idx = 0; while (is_pi(e)) { expr mvar = mk_metavar(name(*g_prefix, idx), binding_domain(e)); idx++; explicit_args.push_back(is_explicit(binding_info(e))); metas.push_back(mvar); e = instantiate(binding_body(e), mvar); pr = mk_app(pr, mvar); } expr rel, lhs, rhs; if (!is_simp_relation(env, e, rel, lhs, rhs) || !is_constant(rel)) { throw exception(sstream() << "invalid congruence rule, '" << n << "' resulting type is not of the form t ~ s, where '~' is a transitive and reflexive relation"); } name_set found_mvars; buffer<expr> lhs_args, rhs_args; expr const & lhs_fn = get_app_args(lhs, lhs_args); expr const & rhs_fn = get_app_args(rhs, rhs_args); if (is_constant(lhs_fn)) { if (!is_constant(rhs_fn) || const_name(lhs_fn) != const_name(rhs_fn) || lhs_args.size() != rhs_args.size()) { throw exception(sstream() << "invalid congruence rule, '" << n << "' resulting type is not of the form (" << const_name(lhs_fn) << " ...) " << "~ (" << const_name(lhs_fn) << " ...), where ~ is '" << const_name(rel) << "'"); } for (expr const & lhs_arg : lhs_args) { if (is_sort(lhs_arg)) continue; if (!is_metavar(lhs_arg) || found_mvars.contains(mlocal_name(lhs_arg))) { throw exception(sstream() << "invalid congruence rule, '" << n << "' the left-hand-side of the congruence resulting type must be of the form (" << const_name(lhs_fn) << " x_1 ... x_n), where each x_i is a distinct variable or a sort"); } found_mvars.insert(mlocal_name(lhs_arg)); } } else if (is_binding(lhs)) { if (lhs.kind() != rhs.kind()) { throw exception(sstream() << "invalid congruence rule, '" << n << "' kinds of the left-hand-side and right-hand-side of " << "the congruence resulting type do not match"); } if (!is_valid_congr_rule_binding_lhs(lhs, found_mvars)) { throw exception(sstream() << "invalid congruence rule, '" << n << "' left-hand-side of the congruence resulting type must " << "be of the form (fun/Pi (x : A), B x)"); } } else { throw exception(sstream() << "invalid congruence rule, '" << n << "' left-hand-side is not an application nor a binding"); } buffer<expr> congr_hyps; lean_assert(metas.size() == explicit_args.size()); for (unsigned i = 0; i < metas.size(); i++) { expr const & mvar = metas[i]; if (explicit_args[i] && !found_mvars.contains(mlocal_name(mvar))) { buffer<expr> locals; expr type = mlocal_type(mvar); while (is_pi(type)) { expr local = mk_local(tc.mk_fresh_name(), binding_domain(type)); locals.push_back(local); type = instantiate(binding_body(type), local); } expr h_rel, h_lhs, h_rhs; if (!is_simp_relation(env, type, h_rel, h_lhs, h_rhs) || !is_constant(h_rel)) continue; unsigned j = 0; for (expr const & local : locals) { j++; if (!only_found_mvars(mlocal_type(local), found_mvars)) { throw exception(sstream() << "invalid congruence rule, '" << n << "' argument #" << j << " of parameter #" << (i+1) << " contains " << "unresolved parameters"); } } if (!only_found_mvars(h_lhs, found_mvars)) { throw exception(sstream() << "invalid congruence rule, '" << n << "' argument #" << (i+1) << " is not a valid hypothesis, the left-hand-side contains " << "unresolved parameters"); } if (!is_valid_congr_hyp_rhs(h_rhs, found_mvars)) { throw exception(sstream() << "invalid congruence rule, '" << n << "' argument #" << (i+1) << " is not a valid hypothesis, the right-hand-side must be " << "of the form (m l_1 ... l_n) where m is parameter that was not " << "'assigned/resolved' yet and l_i's are locals"); } found_mvars.insert(mlocal_name(mvar)); congr_hyps.push_back(mvar); } } congr_rule rule(n, ls, to_list(metas), lhs, rhs, pr, to_list(congr_hyps)); s.insert(const_name(rel), rule); }