diff --git a/src/library/blast/infer_type.cpp b/src/library/blast/infer_type.cpp index 4bc85bc14..1682935df 100644 --- a/src/library/blast/infer_type.cpp +++ b/src/library/blast/infer_type.cpp @@ -7,6 +7,7 @@ Author: Leonardo de Moura #include "util/interrupt.h" #include "kernel/instantiate.h" #include "kernel/abstract.h" +#include "library/normalize.h" #include "library/blast/infer_type.h" #include "library/blast/blast_context.h" #include "library/blast/blast_exception.h" @@ -105,11 +106,6 @@ expr whnf(expr const & e) { } } -bool is_def_eq(expr const & e1, expr const & e2) { - // TODO(Leo) - return e1 == e2; -} - static expr infer_constant(expr const & e) { declaration d = env().get(const_name(e)); auto const & ps = d.get_univ_params(); @@ -184,6 +180,8 @@ static void ensure_pi(expr const & e, expr const & ref) { // Remark: for simplicity reasons, we just fail if \c e is not a Pi. if (!is_pi(e)) throw blast_exception("infer type failed, Pi expected", ref); + // Potential problem: e is of the form (f ...) where f is a constant that is not marked as reducible. + // So, whnf does not reduce it, and we fail to detect that e is can be reduced to a Pi-expression. } static expr infer_app(expr const & e) { @@ -250,4 +248,167 @@ expr infer_type(expr const & e) { // TODO(Leo): cache results if we have performance problems return r; } + +bool is_prop(expr const & e) { + if (env().impredicative()) { + expr t = whnf(infer_type(e)); + return t == mk_Prop(); + } else { + return false; + } +} + +bool is_def_eq(level const & l1, level const & l2) { + if (is_equivalent(l1, l2)) { + return true; + } else { + // TODO(Leo): check/update universe level assignment + lean_unreachable(); + return false; + } +} + +bool is_def_eq(levels const & ls1, levels const & ls2) { + if (is_nil(ls1) && is_nil(ls2)) { + return true; + } else if (!is_nil(ls1) && !is_nil(ls2)) { + return + is_def_eq(head(ls1), head(ls2)) && + is_def_eq(tail(ls1), tail(ls2)); + } else { + return false; + } +} + +/** \brief Given \c e of the form ?m t_1 ... t_n, where + ?m is an assigned mref, substitute \c ?m with its assignment. */ +static expr subst_mref(expr const & e) { + // TODO(Leo): + lean_unreachable(); +} + +/** \brief Given \c m of the form ?m t_1 ... t_n, (try to) assign + ?m to (an abstraction of) v. Return true if success and false otherwise. */ +static bool assign_mref(expr const & m, expr const & v) { + // TODO(Leo): + lean_unreachable(); +} + +static bool is_def_eq_binding(expr e1, expr e2) { + lean_assert(e1.kind() == e2.kind()); + lean_assert(is_binding(e1)); + expr_kind k = e1.kind(); + buffer subst; + do { + optional var_e1_type; + if (binding_domain(e1) != binding_domain(e2)) { + var_e1_type = instantiate_rev(binding_domain(e1), subst.size(), subst.data()); + expr var_e2_type = instantiate_rev(binding_domain(e2), subst.size(), subst.data()); + if (!is_def_eq(var_e2_type, *var_e1_type)) + return false; + } + if (!closed(binding_body(e1)) || !closed(binding_body(e2))) { + // local is used inside t or s + if (!var_e1_type) + var_e1_type = instantiate_rev(binding_domain(e1), subst.size(), subst.data()); + subst.push_back(blast::mk_local(mk_fresh_local_name(), binding_name(e1), + *var_e1_type, binding_info(e1))); + } else { + expr const & dont_care = mk_Prop(); + subst.push_back(dont_care); + } + e1 = binding_body(e1); + e2 = binding_body(e2); + } while (e1.kind() == k && e2.kind() == k); + return is_def_eq(instantiate_rev(e1, subst.size(), subst.data()), + instantiate_rev(e2, subst.size(), subst.data())); +} + +static bool is_def_eq_app(expr const & e1, expr const & e2) { + lean_assert(is_app(e1) && is_app(e2)); + buffer args1, args2; + expr const & f1 = get_app_args(e1, args1); + expr const & f2 = get_app_args(e2, args2); + if (args1.size() != args2.size() || !is_def_eq(f1, f2)) + return false; + for (unsigned i = 0; i < args1.size(); i++) { + if (!is_def_eq(args1[i], args2[i])) + return false; + } + return true; +} + +static bool is_def_eq_eta(expr const & e1, expr const & e2) { + expr new_e1 = try_eta(e1); + expr new_e2 = try_eta(e2); + if (e1 != new_e1 || e2 != new_e2) + return is_def_eq(new_e1, new_e2); + return false; +} + +static bool is_def_eq_proof_irrel(expr const & e1, expr const & e2) { + if (!env().prop_proof_irrel()) + return false; + expr e1_type = infer_type(e1); + expr e2_type = infer_type(e2); + return is_prop(e1_type) && is_def_eq(e1_type, e2_type); +} + +bool is_def_eq(expr const & e1, expr const & e2) { + check_system("is_def_eq"); + if (e1 == e2) + return true; + state & s = curr_state(); + expr const & f1 = get_app_fn(e1); + if (is_mref(f1)) { + if (s.is_mref_assigned(f1)) { + return is_def_eq(subst_mref(e1), e2); + } else { + return assign_mref(e1, e2); + } + } + expr const & f2 = get_app_fn(e2); + if (is_mref(f2)) { + if (s.is_mref_assigned(f2)) { + return is_def_eq(e1, subst_mref(e2)); + } else { + return assign_mref(e2, e1); + } + } + expr e1_n = whnf(e1); + expr e2_n = whnf(e2); + if (e1 != e1_n || e2 != e2_n) + return is_def_eq(e1_n, e2_n); + if (e1.kind() == e2.kind()) { + switch (e1.kind()) { + case expr_kind::Lambda: + case expr_kind::Pi: + if (is_def_eq_binding(e1, e2)) + return true; + break; + case expr_kind::Sort: + if (is_def_eq(sort_level(e1), sort_level(e2))) + return true; + break; + case expr_kind::Meta: + case expr_kind::Var: + lean_unreachable(); // LCOV_EXCL_LINE + case expr_kind::Local: + case expr_kind::Macro: + break; + case expr_kind::Constant: + if (const_name(e1) == const_name(e2) && + is_def_eq(const_levels(e1), const_levels(e2))) + return true; + break; + case expr_kind::App: + if (is_def_eq_app(e1, e2)) + return true; + break; + } + } + if (is_def_eq_eta(e1, e2)) + return true; + return is_def_eq_proof_irrel(e1, e2); +} }} diff --git a/src/library/blast/infer_type.h b/src/library/blast/infer_type.h index 77f51c86c..ea9b3f859 100644 --- a/src/library/blast/infer_type.h +++ b/src/library/blast/infer_type.h @@ -12,16 +12,20 @@ namespace blast { /** \brief Put the given expression in weak-head-normal-form with respect to the current state being processed by the blast tactic. */ expr whnf(expr const & e); -/** \brief Return true iff the two expressions are definitionally equal in the - current state being processed by the blast tactic. - - \remark: (potential side-effect) this procedure may update the meta-variable assignment - associated with the current state. */ -bool is_def_eq(expr const & e1, expr const & e2); /** \brief Return the type of the given expression with respect to the current state being processed by the blast tactic. \remark: (potential side-effect) this procedure may update the meta-variable assignment associated with the current state. */ expr infer_type(expr const & e); +/** \brief Return true if \c e is a Proposition */ +bool is_prop(expr const & e); +/** \brief Return true iff the two expressions are definitionally equal in the + current state being processed by the blast tactic. + + \remark: (potential side-effect) this procedure may update the meta-variable assignment + associated with the current state. */ +bool is_def_eq(expr const & e1, expr const & e2); +bool is_def_eq(level const & l1, level const & l2); +bool is_def_eq(levels const & l1, levels const & l2); }} diff --git a/src/library/blast/state.h b/src/library/blast/state.h index 0f852b5cf..390f28d33 100644 --- a/src/library/blast/state.h +++ b/src/library/blast/state.h @@ -66,6 +66,11 @@ public: The context of this metavariable will be all hypotheses occurring in the main branch. */ expr mk_metavar(expr const & type); + bool is_mref_assigned(expr const & e) const { + lean_assert(is_mref(e)); + return m_eassignment.contains(mref_index(e)); + } + /** \brief Add a new hypothesis to the main branch */ expr add_hypothesis(name const & n, expr const & type, optional const & value, optional const & jst) { return m_main.add_hypothesis(n, type, value, jst);