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; } }
bool is_ceqv(type_checker & tc, expr e) { if (has_expr_metavar(e)) return false; name_set to_find; // Define a procedure for removing arguments from to_find. auto visitor_fn = [&](expr const & e, unsigned) { if (is_local(e)) { to_find.erase(mlocal_name(e)); return false; } else if (is_metavar(e)) { return false; } else { return true; } }; environment const & env = tc.env(); bool is_std = is_standard(env); buffer<expr> hypotheses; // arguments that are propositions while (is_pi(e)) { if (!to_find.empty()) { // Support for dependent types. // We may find the instantiation for the previous arguments // by matching the type. for_each(binding_domain(e), visitor_fn); } expr local = mk_local(tc.mk_fresh_name(), binding_domain(e)); if (binding_info(e).is_inst_implicit()) { // If the argument can be instantiated by type class resolution, then // we don't need to find it in the lhs } else if (is_std && tc.is_prop(binding_domain(e)).first) { // If the argument is a proposition, we store it in hypotheses. // We check whether the lhs occurs in hypotheses or not. hypotheses.push_back(binding_domain(e)); } else { to_find.insert(mlocal_name(local)); } e = instantiate(binding_body(e), local); } expr lhs, rhs; if (!is_simp_relation(env, e, lhs, rhs)) return false; // traverse lhs, and remove found variables from to_find for_each(lhs, visitor_fn); if (!to_find.empty()) return false; // basic looping ceq detection: the left-hand-side should not occur in the right-hand-side, // nor it should occur in any of the hypothesis if (occurs(lhs, rhs)) return false; if (std::any_of(hypotheses.begin(), hypotheses.end(), [&](expr const & h) { return occurs(lhs, h); })) return false; return true; }
list<expr> get_coercions_from_to(type_checker & from_tc, type_checker & to_tc, expr const & from_type, expr const & to_type, constraint_seq & cs, bool lift_coe) { constraint_seq new_cs; environment const & env = to_tc.env(); expr whnf_from_type = from_tc.whnf(from_type, new_cs); expr whnf_to_type = to_tc.whnf(to_type, new_cs); if (lift_coe && is_pi(whnf_from_type)) { // Try to lift coercions. // The idea is to convert a coercion from A to B, into a coercion from D->A to D->B if (!is_pi(whnf_to_type)) return list<expr>(); // failed if (!from_tc.is_def_eq(binding_domain(whnf_from_type), binding_domain(whnf_to_type), justification(), new_cs)) return list<expr>(); // failed, the domains must be definitionally equal expr x = mk_local(mk_fresh_name(), "x", binding_domain(whnf_from_type), binder_info()); expr A = instantiate(binding_body(whnf_from_type), x); expr B = instantiate(binding_body(whnf_to_type), x); list<expr> coe = get_coercions_from_to(from_tc, to_tc, A, B, new_cs, lift_coe); if (coe) { cs += new_cs; // Remark: each coercion c in coe is a function from A to B // We create a new list: (fun (f : D -> A) (x : D), c (f x)) expr f = mk_local(mk_fresh_name(), "f", whnf_from_type, binder_info()); expr fx = mk_app(f, x); return map(coe, [&](expr const & c) { return Fun(f, Fun(x, mk_app(c, fx))); }); } else { return list<expr>(); } } else { expr const & fn = get_app_fn(whnf_to_type); list<expr> r; if (is_constant(fn)) { r = get_coercions(env, whnf_from_type, const_name(fn)); } else if (is_pi(whnf_to_type)) { r = get_coercions_to_fun(env, whnf_from_type); } else if (is_sort(whnf_to_type)) { r = get_coercions_to_sort(env, whnf_from_type); } if (r) cs += new_cs; return r; } }
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); }
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); }
expr visit_macro(expr const & e) { buffer<expr> new_args; for (unsigned i = 0; i < macro_num_args(e); i++) new_args.push_back(visit(macro_arg(e, i))); auto def = macro_def(e); expr r = update_macro(e, new_args.size(), new_args.data()); if (def.trust_level() >= m_trust_lvl) { if (optional<expr> new_r = m_tc.expand_macro(r)) { return *new_r; } else { throw_generic_exception("failed to expand macro", e); } } else { return r; } }
expr extract(expr const & e) { lean_assert(is_nested_declaration(e)); expr const & d = visit(get_nested_declaration_arg(e)); name new_name = mk_name_for(e); name new_real_name = get_namespace(m_env) + new_name; collected_locals locals; collect_locals(d, locals); buffer<name> uparams; collect_univ_params(d).to_buffer(uparams); expr new_value = Fun(locals.get_collected(), d); expr new_type = m_tc.infer(new_value).first; level_param_names new_ps = to_list(uparams); levels ls = param_names_to_levels(new_ps); m_env = module::add(m_env, check(m_env, mk_definition(m_env, new_real_name, new_ps, new_type, new_value))); if (new_name != new_real_name) m_env = add_expr_alias_rec(m_env, new_name, new_real_name); decl_attributes const & attrs = get_nested_declaration_attributes(e); m_env = attrs.apply(m_env, m_ios, new_real_name, get_namespace(m_env)); return mk_app(mk_constant(new_real_name, ls), locals.get_collected()); }
expr visit_binding(expr e) { expr_kind k = e.kind(); buffer<expr> es; buffer<expr> ls; while (e.kind() == k) { expr d = visit(instantiate_rev(binding_domain(e), ls.size(), ls.data())); expr l = mk_local(m_tc.mk_fresh_name(), binding_name(e), d, binding_info(e)); ls.push_back(l); es.push_back(e); e = binding_body(e); } e = visit(instantiate_rev(e, ls.size(), ls.data())); expr r = abstract_locals(e, ls.size(), ls.data()); while (!ls.empty()) { expr d = mlocal_type(ls.back()); ls.pop_back(); d = abstract_locals(d, ls.size(), ls.data()); r = update_binding(es.back(), d, r); es.pop_back(); } return r; }
simp_rule_sets add_core(type_checker & tc, simp_rule_sets const & s, name const & id, levels const & univ_metas, expr const & e, expr const & h) { list<expr_pair> ceqvs = to_ceqvs(tc, e, h); environment const & env = tc.env(); simp_rule_sets new_s = s; for (expr_pair const & p : ceqvs) { expr new_e = p.first; expr new_h = p.second; bool is_perm = is_permutation_ceqv(env, new_e); buffer<expr> metas; unsigned idx = 0; while (is_pi(new_e)) { expr mvar = mk_metavar(name(*g_prefix, idx), binding_domain(new_e)); idx++; metas.push_back(mvar); new_e = instantiate(binding_body(new_e), mvar); } expr rel, lhs, rhs; if (is_simp_relation(env, new_e, rel, lhs, rhs) && is_constant(rel)) { new_s.insert(const_name(rel), simp_rule(id, univ_metas, to_list(metas), lhs, rhs, new_h, is_perm)); } } return new_s; }
optional<expr> mk_hset_instance(type_checker & tc, io_state const & ios, list<expr> const & ctx, expr const & type) { expr trunc_index = mk_app(mk_constant(get_is_trunc_trunc_index_of_nat_name()), mk_constant(get_nat_zero_name())); level lvl = sort_level(tc.ensure_type(type).first); expr is_hset = mk_app(mk_constant(get_is_trunc_name(), {lvl}), trunc_index, type); return mk_class_instance(tc.env(), ios, ctx, tc.mk_fresh_name(), is_hset); }
/** \brief Given a term <tt>a : a_type</tt>, and a metavariable \c m, creates a constraint that considers coercions from a_type to the type assigned to \c m. */ constraint mk_coercion_cnstr(type_checker & from_tc, type_checker & to_tc, coercion_info_manager & infom, expr const & m, expr const & a, expr const & a_type, justification const & j, unsigned delay_factor, bool lift_coe) { auto choice_fn = [=, &from_tc, &to_tc, &infom](expr const & meta, expr const & d_type, substitution const & s) { expr new_a_type; justification new_a_type_jst; if (is_meta(a_type)) { auto p = substitution(s).instantiate_metavars(a_type); new_a_type = p.first; new_a_type_jst = p.second; } else { new_a_type = a_type; } if (is_meta(new_a_type)) { if (delay_factor < to_delay_factor(cnstr_group::DelayedChoice)) { // postpone... return lazy_list<constraints>(constraints(mk_coercion_cnstr(from_tc, to_tc, infom, m, a, a_type, justification(), delay_factor+1, lift_coe))); } else { // giveup... return lazy_list<constraints>(constraints(mk_eq_cnstr(meta, a, justification()))); } } constraint_seq cs; new_a_type = from_tc.whnf(new_a_type, cs); if ((lift_coe && is_pi_meta(d_type)) || (!lift_coe && is_meta(d_type))) { // case-split buffer<expr> locals; expr it_from = new_a_type; expr it_to = d_type; while (is_pi(it_from) && is_pi(it_to)) { expr dom_from = binding_domain(it_from); expr dom_to = binding_domain(it_to); if (!from_tc.is_def_eq(dom_from, dom_to, justification(), cs)) return lazy_list<constraints>(); expr local = mk_local(mk_fresh_name(), binding_name(it_from), dom_from, binder_info()); locals.push_back(local); it_from = instantiate(binding_body(it_from), local); it_to = instantiate(binding_body(it_to), local); } buffer<expr> alts; get_coercions_from(from_tc.env(), it_from, alts); expr fn_a; if (!locals.empty()) fn_a = mk_local(mk_fresh_name(), "f", new_a_type, binder_info()); buffer<constraints> choices; buffer<expr> coes; // first alternative: no coercion constraint_seq cs1 = cs + mk_eq_cnstr(meta, a, justification()); choices.push_back(cs1.to_list()); unsigned i = alts.size(); while (i > 0) { --i; expr coe = alts[i]; if (!locals.empty()) coe = Fun(fn_a, Fun(locals, mk_app(coe, mk_app(fn_a, locals)))); expr new_a = copy_tag(a, mk_app(coe, a)); coes.push_back(coe); constraint_seq csi = cs + mk_eq_cnstr(meta, new_a, new_a_type_jst); choices.push_back(csi.to_list()); } return choose(std::make_shared<coercion_elaborator>(infom, meta, to_list(choices.begin(), choices.end()), to_list(coes.begin(), coes.end()))); } else { list<expr> coes = get_coercions_from_to(from_tc, to_tc, new_a_type, d_type, cs, lift_coe); if (is_nil(coes)) { expr new_a = a; infom.erase_coercion_info(a); cs += mk_eq_cnstr(meta, new_a, new_a_type_jst); return lazy_list<constraints>(cs.to_list()); } else if (is_nil(tail(coes))) { expr new_a = copy_tag(a, mk_app(head(coes), a)); infom.save_coercion_info(a, new_a); cs += mk_eq_cnstr(meta, new_a, new_a_type_jst); return lazy_list<constraints>(cs.to_list()); } else { list<constraints> choices = map2<constraints>(coes, [&](expr const & coe) { expr new_a = copy_tag(a, mk_app(coe, a)); constraint c = mk_eq_cnstr(meta, new_a, new_a_type_jst); return (cs + c).to_list(); }); return choose(std::make_shared<coercion_elaborator>(infom, meta, choices, coes, false)); } } }; return mk_choice_cnstr(m, choice_fn, delay_factor, true, j); }
std::cout << "expected error: " << ex.pp(mk_formatter(ex.get_environment())) << "\n"; } try { auto env7 = add_decl(env2, mk_definition("foo", level_param_names(), mk_Type() >> mk_Type(), mk_Prop())); lean_unreachable(); } catch (kernel_exception & ex) { std::cout << "expected error: " << ex.pp(mk_formatter(ex.get_environment())) << "\n"; } expr A = Local("A", Type); expr x = Local("x", A); auto env3 = add_decl(env2, mk_definition("id", level_param_names(), Pi(A, A >> A), Fun({A, x}, x))); expr c = mk_local("c", Prop); expr id = Const("id"); type_checker checker(env3, name_generator("tmp")); lean_assert(checker.check(id(Prop)) == Prop >> Prop); lean_assert(checker.whnf(id(Prop, c)) == c); lean_assert(checker.whnf(id(Prop, id(Prop, id(Prop, c)))) == c); type_checker checker2(env2, name_generator("tmp")); lean_assert(checker2.whnf(id(Prop, id(Prop, id(Prop, c)))) == id(Prop, id(Prop, id(Prop, c)))); } static void tst2() { environment env; name base("base"); env = add_decl(env, mk_var_decl(name(base, 0u), level_param_names(), Prop >> (Prop >> Prop))); expr x = Local("x", Prop); expr y = Local("y", Prop); for (unsigned i = 1; i <= 100; i++) {
expr visit_binding(expr const & b) { expr new_domain = visit(binding_domain(b)); expr l = mk_local(m_tc.mk_fresh_name(), new_domain); expr new_body = abstract(visit(instantiate(binding_body(b), l)), l); return update_binding(b, new_domain, new_body); }
to_ceqvs_fn(type_checker & tc):m_env(tc.env()), m_tc(tc) {}
get_noncomputable_reason_fn(type_checker & tc): m_tc(tc), m_ext(get_extension(tc.env())) { }
try { auto env7 = add_decl(env2, mk_definition("foo", level_param_names(), mk_Type() >> mk_Type(), mk_Prop())); lean_unreachable(); } catch (kernel_exception & ex) { std::cout << "expected error: " << ex.pp(mk_formatter(ex.get_environment())) << "\n"; } expr Type = mk_Type(); expr A = Local("A", Type); expr x = Local("x", A); auto env3 = add_decl(env2, mk_definition("id", level_param_names(), Pi(A, A >> A), Fun({A, x}, x))); expr Prop = mk_Prop(); expr c = mk_local("c", Prop); expr id = Const("id"); type_checker checker(env3, name_generator("tmp")); lean_assert(checker.check(mk_app(id, Prop)).first == Prop >> Prop); lean_assert(checker.whnf(mk_app(id, Prop, c)).first == c); lean_assert(checker.whnf(mk_app(id, Prop, mk_app(id, Prop, mk_app(id, Prop, c)))).first == c); type_checker checker2(env2, name_generator("tmp")); lean_assert(checker2.whnf(mk_app(id, Prop, mk_app(id, Prop, mk_app(id, Prop, c)))).first == mk_app(id, Prop, mk_app(id, Prop, mk_app(id, Prop, c)))); } static void tst2() { environment env; name base("base"); expr Prop = mk_Prop(); env = add_decl(env, mk_constant_assumption(name(base, 0u), level_param_names(), Prop >> (Prop >> Prop))); expr x = Local("x", Prop); expr y = Local("y", Prop);
name converter::mk_fresh_name(type_checker & tc) { return tc.mk_fresh_name(); }
pair<expr, constraint_seq> converter::infer_type(type_checker & tc, expr const & e) { return tc.infer_type(e); }