/* Copyright (c) 2014 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Leonardo de Moura */ #include #include #include #include #include #include "util/interrupt.h" #include "util/luaref.h" #include "util/lazy_list_fn.h" #include "util/sstream.h" #include "util/lbool.h" #include "util/flet.h" #include "util/sexpr/option_declarations.h" #include "kernel/for_each_fn.h" #include "kernel/abstract.h" #include "kernel/instantiate.h" #include "kernel/type_checker.h" #include "kernel/kernel_exception.h" #include "kernel/error_msgs.h" #include "library/normalize.h" #include "library/occurs.h" #include "library/locals.h" #include "library/module.h" #include "library/unifier.h" #include "library/reducible.h" #include "library/unifier_plugin.h" #include "library/kernel_bindings.h" #include "library/print.h" #include "library/expr_lt.h" #ifndef LEAN_DEFAULT_UNIFIER_MAX_STEPS #define LEAN_DEFAULT_UNIFIER_MAX_STEPS 20000 #endif #ifndef LEAN_DEFAULT_UNIFIER_COMPUTATION #define LEAN_DEFAULT_UNIFIER_COMPUTATION false #endif #ifndef LEAN_DEFAULT_UNIFIER_EXPENSIVE_CLASSES #define LEAN_DEFAULT_UNIFIER_EXPENSIVE_CLASSES false #endif namespace lean { static name * g_unifier_max_steps = nullptr; static name * g_unifier_computation = nullptr; static name * g_unifier_expensive_classes = nullptr; unsigned get_unifier_max_steps(options const & opts) { return opts.get_unsigned(*g_unifier_max_steps, LEAN_DEFAULT_UNIFIER_MAX_STEPS); } bool get_unifier_computation(options const & opts) { return opts.get_bool(*g_unifier_computation, LEAN_DEFAULT_UNIFIER_COMPUTATION); } bool get_unifier_expensive_classes(options const & opts) { return opts.get_bool(*g_unifier_expensive_classes, LEAN_DEFAULT_UNIFIER_EXPENSIVE_CLASSES); } unifier_config::unifier_config(bool use_exceptions, bool discard): m_use_exceptions(use_exceptions), m_max_steps(LEAN_DEFAULT_UNIFIER_MAX_STEPS), m_computation(LEAN_DEFAULT_UNIFIER_COMPUTATION), m_expensive_classes(LEAN_DEFAULT_UNIFIER_EXPENSIVE_CLASSES), m_discard(discard) { m_cheap = false; m_ignore_context_check = false; } unifier_config::unifier_config(options const & o, bool use_exceptions, bool discard): m_use_exceptions(use_exceptions), m_max_steps(get_unifier_max_steps(o)), m_computation(get_unifier_computation(o)), m_expensive_classes(get_unifier_expensive_classes(o)), m_discard(discard) { m_cheap = false; m_ignore_context_check = false; } // If \c e is a metavariable ?m or a term of the form (?m l_1 ... l_n) where // l_1 ... l_n are distinct local variables, then return ?m, and store l_1 ... l_n in args. // Otherwise return none. optional is_simple_meta(expr const & e, buffer & args) { expr const & m = get_app_args(e, args); if (!is_metavar(m)) return none_expr(); for (auto it = args.begin(); it != args.end(); it++) { if (!is_local(*it) || contains_local(*it, args.begin(), it)) return none_expr(); } return some_expr(m); } bool is_simple_meta(expr const & e) { buffer args; return (bool)is_simple_meta(e, args); // NOLINT } // Return true if all local constants in \c e are in locals bool context_check(expr const & e, buffer const & locals) { bool failed = false; for_each(e, [&](expr const & e, unsigned) { if (failed) return false; if (is_local(e) && !contains_local(e, locals)) { failed = true; return false; } if (is_metavar(e)) return false; // do not visit type return has_local(e); }); return !failed; } enum class occurs_check_status { Ok, Maybe, FailCircular, FailLocal }; // Return // - l_undef if \c e contains a metavariable application that contains // a local constant not in locals // - l_true if \c e does not contain the metavariable \c m, and all local // constants are in \c e are in \c locals. // - l_false if \c e contains \c m or it contains a local constant \c l // not in locals that is not in a metavariable application. occurs_check_status occurs_context_check(substitution & s, expr const & e, expr const & m, buffer const & locals, expr & bad_local) { expr root = e; occurs_check_status r = occurs_check_status::Ok; for_each(e, [&](expr const & e, unsigned) { if (r == occurs_check_status::FailLocal || r == occurs_check_status::FailCircular) { return false; } else if (is_local(e)) { if (!contains_local(e, locals)) { // right-hand-side contains variable that is not in the scope // of metavariable. bad_local = e; r = occurs_check_status::FailLocal; } return false; // do not visit type } else if (is_meta(e)) { if (r == occurs_check_status::Ok) { if (!context_check(e, locals)) r = occurs_check_status::Maybe; if (s.occurs(m, e)) r = occurs_check_status::Maybe; } if (mlocal_name(get_app_fn(e)) == mlocal_name(m)) r = occurs_check_status::FailCircular; return false; // do not visit children } else { // we only need to continue exploring e if it contains // metavariables and/or local constants. return has_expr_metavar(e) || has_local(e); } }); if (r != occurs_check_status::Ok) return r; for (expr const & local : locals) { if (s.occurs(m, mlocal_type(local))) return occurs_check_status::Maybe; } return r; } occurs_check_status occurs_context_check(substitution & s, expr const & e, expr const & m, buffer const & locals) { expr bad_local; return occurs_context_check(s, e, m, locals, bad_local); } unify_status unify_simple_core(substitution & s, expr const & lhs, expr const & rhs, justification const & j) { lean_assert(is_meta(lhs)); buffer args; auto m = is_simple_meta(lhs, args); if (!m || is_meta(rhs)) { return unify_status::Unsupported; } else { switch (occurs_context_check(s, rhs, *m, args)) { case occurs_check_status::FailLocal: case occurs_check_status::FailCircular: return unify_status::Failed; case occurs_check_status::Maybe: return unify_status::Unsupported; case occurs_check_status::Ok: { expr v = Fun(args, rhs); s.assign(mlocal_name(*m), v, j); return unify_status::Solved; }} } lean_unreachable(); // LCOV_EXCL_LINE } unify_status unify_simple(substitution & s, expr const & lhs, expr const & rhs, justification const & j) { if (lhs == rhs) return unify_status::Solved; else if (!has_metavar(lhs) && !has_metavar(rhs)) return unify_status::Failed; else if (is_meta(lhs)) return unify_simple_core(s, lhs, rhs, j); else if (is_meta(rhs)) return unify_simple_core(s, rhs, lhs, j); else return unify_status::Unsupported; } // Return true if m occurs in e bool occurs_meta(level const & m, level const & e) { lean_assert(is_meta(m)); bool contains = false; for_each(e, [&](level const & l) { if (contains) return false; if (l == m) { contains = true; return false; } return has_meta(l); }); return contains; } unify_status unify_simple_core(substitution & s, level const & lhs, level const & rhs, justification const & j) { lean_assert(is_meta(lhs)); bool contains = occurs_meta(lhs, rhs); if (contains) { if (is_succ(rhs)) return unify_status::Failed; else return unify_status::Unsupported; } s.assign(meta_id(lhs), rhs, j); return unify_status::Solved; } unify_status unify_simple(substitution & s, level const & lhs, level const & rhs, justification const & j) { if (lhs == rhs) return unify_status::Solved; else if (!has_meta(lhs) && !has_meta(rhs)) return unify_status::Failed; else if (is_meta(lhs)) return unify_simple_core(s, lhs, rhs, j); else if (is_meta(rhs)) return unify_simple_core(s, rhs, lhs, j); else if (is_succ(lhs) && is_succ(rhs)) return unify_simple(s, succ_of(lhs), succ_of(rhs), j); else return unify_status::Unsupported; } unify_status unify_simple(substitution & s, constraint const & c) { if (is_eq_cnstr(c)) return unify_simple(s, cnstr_lhs_expr(c), cnstr_rhs_expr(c), c.get_justification()); else if (is_level_eq_cnstr(c)) return unify_simple(s, cnstr_lhs_level(c), cnstr_rhs_level(c), c.get_justification()); else return unify_status::Unsupported; } static constraint * g_dont_care_cnstr = nullptr; static unsigned g_group_size = 1u << 28; constexpr unsigned g_num_groups = 8; static unsigned g_cnstr_group_first_index[g_num_groups] = { 0, g_group_size, 2*g_group_size, 3*g_group_size, 4*g_group_size, 5*g_group_size, 6*g_group_size, 7*g_group_size}; static unsigned get_group_first_index(cnstr_group g) { return g_cnstr_group_first_index[static_cast(g)]; } static cnstr_group to_cnstr_group(unsigned d) { if (d >= g_num_groups) d = g_num_groups-1; return static_cast(d); } /** \brief Convert choice constraint delay factor to cnstr_group */ cnstr_group get_choice_cnstr_group(constraint const & c) { lean_assert(is_choice_cnstr(c)); unsigned f = cnstr_delay_factor(c); if (f > static_cast(cnstr_group::MaxDelayed)) { return cnstr_group::MaxDelayed; } else { return static_cast(f); } } /** \brief Auxiliary functional object for implementing simultaneous higher-order unification */ struct unifier_fn { typedef pair cnstr; // constraint + idx struct cnstr_cmp { int operator()(cnstr const & c1, cnstr const & c2) const { return c1.second < c2.second ? -1 : (c1.second == c2.second ? 0 : 1); } }; typedef rb_tree cnstr_set; typedef rb_tree cnstr_idx_set; typedef name_map name_to_cnstrs; typedef name_map owned_map; typedef rb_map, expr_quick_cmp> expr_map; typedef std::shared_ptr type_checker_ptr; environment m_env; name_generator m_ngen; substitution m_subst; constraints m_postponed; // constraints that will not be solved owned_map m_owned_map; // mapping from metavariable name m to delay factor of the choice constraint that owns m expr_map m_type_map; // auxiliary map for storing the type of the expr in choice constraints unifier_plugin m_plugin; type_checker_ptr m_tc[2]; type_checker_ptr m_flex_rigid_tc[2]; // type checker used when solving flex rigid constraints. By default, // only the definitions from the main module are treated as transparent. unifier_config m_config; unsigned m_num_steps; bool m_pattern; //!< If true, then only higher-order (pattern) matching is used bool m_first; //!< True if we still have to generate the first solution. unsigned m_next_assumption_idx; //!< Next assumption index. unsigned m_next_cidx; //!< Next constraint index. /** \brief "Queue" of constraints to be solved. We implement it using a red-black-tree because: 1- Our red-black-trees support a O(1) copy operation. So, it is cheap to create a snapshot whenever we create a backtracking point. 2- We can easily remove any constraint from the queue in O(n log n). We do that when a metavariable \c m is assigned, and we want to instantiate it in all constraints that contains it. */ cnstr_set m_cnstrs; /** \brief The following map is an index. The map a metavariable name \c m to the set of constraint indices that contain \c m. We use these indices whenever a metavariable \c m is assigned. When the metavariable is assigned, we used this index to remove constraints that contains \c m from \c m_cnstrs, instantiate \c m, and reprocess them. \remark \c m_mvar_occs is for regular metavariables. */ name_to_cnstrs m_mvar_occs; /** \brief Base class for the case-splits created by the unifier. We have three different kinds of case splits: 1- unifier plugin 2- choice constraints 3- higher-order unification */ struct case_split { unsigned m_assumption_idx; // idx of the current assumption justification m_jst; justification m_failed_justifications; // justifications for failed branches // snapshot of unifier's state substitution m_subst; constraints m_postponed; cnstr_set m_cnstrs; expr_map m_type_map; name_to_cnstrs m_mvar_occs; owned_map m_owned_map; bool m_pattern; /** \brief Save unifier's state */ case_split(unifier_fn & u, justification const & j): m_assumption_idx(u.m_next_assumption_idx), m_jst(j), m_subst(u.m_subst), m_postponed(u.m_postponed), m_cnstrs(u.m_cnstrs), m_type_map(u.m_type_map), m_mvar_occs(u.m_mvar_occs), m_owned_map(u.m_owned_map), m_pattern(u.m_pattern) { u.m_next_assumption_idx++; } /** \brief Restore unifier's state with saved values, and update m_assumption_idx and m_failed_justifications. */ void restore_state(unifier_fn & u) { lean_assert(u.in_conflict()); u.m_subst = m_subst; u.m_postponed = m_postponed; u.m_cnstrs = m_cnstrs; u.m_mvar_occs = m_mvar_occs; u.m_owned_map = m_owned_map; u.m_pattern = m_pattern; u.m_type_map = m_type_map; m_assumption_idx = u.m_next_assumption_idx; m_failed_justifications = mk_composite1(m_failed_justifications, *u.m_conflict); u.m_next_assumption_idx++; u.m_conflict = optional(); } justification get_jst() const { return m_jst; } virtual ~case_split() {} virtual bool next(unifier_fn & u) = 0; }; typedef std::vector> case_split_stack; struct lazy_constraints_case_split : public case_split { lazy_list m_tail; lazy_constraints_case_split(unifier_fn & u, justification const & j, lazy_list const & tail): case_split(u, j), m_tail(tail) {} virtual bool next(unifier_fn & u) { return u.next_lazy_constraints_case_split(*this); } }; struct simple_case_split : public case_split { list m_tail; simple_case_split(unifier_fn & u, justification const & j, list const & tail):case_split(u, j), m_tail(tail) {} virtual bool next(unifier_fn & u) { return u.next_simple_case_split(*this); } }; struct delta_unfold_case_split : public case_split { bool m_done; constraint m_cnstr; delta_unfold_case_split(unifier_fn & u, justification const & j, constraint const & c): case_split(u, j), m_done(false), m_cnstr(c) {} virtual bool next(unifier_fn & u) { return u.next_delta_unfold_case_split(*this); } }; case_split_stack m_case_splits; optional m_conflict; //!< if different from none, then there is a conflict. unifier_fn(environment const & env, unsigned num_cs, constraint const * cs, name_generator const & ngen, substitution const & s, unifier_config const & cfg): m_env(env), m_ngen(ngen), m_subst(s), m_plugin(get_unifier_plugin(env)), m_config(cfg), m_num_steps(0), m_pattern(false) { if (m_config.m_cheap) { m_tc[0] = mk_opaque_type_checker(env, m_ngen.mk_child()); m_tc[1] = m_tc[0]; m_flex_rigid_tc[0] = m_tc[0]; m_flex_rigid_tc[1] = m_tc[0]; m_config.m_computation = false; } else { m_tc[0] = mk_type_checker(env, m_ngen.mk_child(), false); m_tc[1] = mk_type_checker(env, m_ngen.mk_child(), true); if (!cfg.m_computation) { m_flex_rigid_tc[0] = mk_type_checker(env, m_ngen.mk_child(), false, true); m_flex_rigid_tc[1] = mk_type_checker(env, m_ngen.mk_child(), true, true); } } m_next_assumption_idx = 0; m_next_cidx = 0; m_first = true; process_input_constraints(num_cs, cs); } void process_input_constraints(unsigned num_cs, constraint const * cs) { // Input choice constraints may have ownership over a metavariable. // So, we must first process them, to make sure the ownership table is initialized before // we solve the remaining constraints for (unsigned i = 0; i < num_cs; i++) { if (cs[i].kind() == constraint_kind::Choice) preprocess_choice_constraint(cs[i]); } for (unsigned i = 0; i < num_cs; i++) { if (cs[i].kind() != constraint_kind::Choice) process_constraint(cs[i]); } } void check_system() { check_interrupted(); if (m_num_steps > m_config.m_max_steps) throw exception(sstream() << "unifier maximum number of steps (" << m_config.m_max_steps << ") exceeded, " << "the maximum number of steps can be increased by setting the option unifier.max_steps " << "(remark: the unifier uses higher order unification and unification-hints, " << "which may trigger non-termination"); m_num_steps++; } bool in_conflict() const { return (bool)m_conflict; } // NOLINT void set_conflict(justification const & j) { m_conflict = j; } void update_conflict(justification const & j) { m_conflict = j; } void reset_conflict() { m_conflict = optional(); lean_assert(!in_conflict()); } expr mk_local_for(expr const & b) { return mk_local(m_ngen.next(), binding_name(b), binding_domain(b), binding_info(b)); } /** \brief Update occurrence index with entry m -> cidx, where \c m is the name of a metavariable, and \c cidx is the index of a constraint that contains \c m. */ void add_mvar_occ(name const & m, unsigned cidx) { cnstr_idx_set s; auto it = m_mvar_occs.find(m); if (it) s = *it; if (!s.contains(cidx)) { s.insert(cidx); m_mvar_occs.insert(m, s); } } void add_meta_occ(expr const & m, unsigned cidx) { lean_assert(is_meta(m)); add_mvar_occ(mlocal_name(get_app_fn(m)), cidx); } /** \brief For each metavariable m in e add an entry m -> cidx at m_mvar_occs. Return true if at least one entry was added. */ bool add_meta_occs(expr const & e, unsigned cidx) { bool added = false; if (has_expr_metavar(e)) { for_each(e, [&](expr const & e, unsigned) { if (is_meta(e)) { add_meta_occ(e, cidx); added = true; return false; } if (is_local(e)) return false; return has_expr_metavar(e); }); } return added; } /** \brief Add constraint to the constraint queue */ unsigned add_cnstr(constraint const & c, cnstr_group g) { unsigned cidx = m_next_cidx + get_group_first_index(g); m_cnstrs.insert(cnstr(c, cidx)); m_next_cidx++; return cidx; } /** \brief Check if \c t1 and \c t2 are definitionally equal, if they are not, set a conflict with justification \c j \remark If relax is true then opaque definitions from the main module are treated as transparent. */ bool is_def_eq(expr const & t1, expr const & t2, justification const & j, bool relax) { try { auto dcs = m_tc[relax]->is_def_eq(t1, t2, j); if (!dcs.first) { // std::cout << "conflict: " << t1 << " =?= " << t2 << "\n"; set_conflict(j); return false; } else { return process_constraints(dcs.second); } } catch (exception&) { set_conflict(j); return false; } } /** \brief Process the given constraints. Return true iff no conflict was detected. */ bool process_constraints(constraint_seq const & cs) { return cs.all_of([&](constraint const & c) { return process_constraint(c); }); } bool process_constraints(buffer const & cs) { for (auto const & c : cs) { if (!process_constraint(c)) return false; } return true; } /** \brief Process constraints in \c cs, and append justification \c j to them. */ bool process_constraints(constraint_seq const & cs, justification const & j) { return cs.all_of([&](constraint const & c) { return process_constraint(update_justification(c, mk_composite1(c.get_justification(), j))); }); } template bool process_constraints(Constraints const & cs, justification const & j) { for (auto const & c : cs) { if (!process_constraint(update_justification(c, mk_composite1(c.get_justification(), j)))) return false; } return true; } /** \brief Put \c e in weak head normal form. \remark If relax is true then opaque definitions from the main module are treated as transparent. \remark Constraints generated in the process are stored in \c cs. */ expr whnf(expr const & e, bool relax, constraint_seq & cs) { return m_tc[relax]->whnf(e, cs); } /** \brief Infer \c e type. \remark Return none if an exception was throw when inferring the type. \remark If relax is true then opaque definitions from the main module are treated as transparent. \remark Constraints generated in the process are stored in \c cs. */ optional infer(expr const & e, bool relax, constraint_seq & cs) { try { return some_expr(m_tc[relax]->infer(e, cs)); } catch (exception &) { return none_expr(); } } expr whnf(expr const & e, justification const & j, bool relax, buffer & cs) { constraint_seq _cs; expr r = whnf(e, relax, _cs); to_buffer(_cs, j, cs); return r; } expr flex_rigid_whnf(expr const & e, justification const & j, bool relax, buffer & cs) { if (m_config.m_computation) { return whnf(e, j, relax, cs); } else { constraint_seq _cs; expr r = m_flex_rigid_tc[relax]->whnf(e, _cs); to_buffer(_cs, j, cs); return r; } } justification mk_assign_justification(expr const & m, expr const & m_type, expr const & v_type, justification const & j) { auto r = j.get_main_expr(); if (!r) r = m; justification new_j = mk_justification(r, [=](formatter const & fmt, substitution const & subst) { substitution s(subst); format r; expr _m = s.instantiate(m); if (is_meta(_m)) { r = format("type error in placeholder assignment"); } else { r = format("type error in placeholder assigned to"); r += pp_indent_expr(fmt, _m); } format expected_fmt, given_fmt; std::tie(expected_fmt, given_fmt) = pp_until_different(fmt, m_type, v_type); r += compose(line(), format("placeholder has type")); r += given_fmt; r += compose(line(), format("but is expected to have type")); r += expected_fmt; r += compose(line(), format("the assignment was attempted when trying to solve")); r += nest(2*get_pp_indent(fmt.get_options()), compose(line(), j.pp(fmt, nullptr, subst))); return r; }); return mk_composite1(new_j, j); } /** \brief Assign \c v to metavariable \c m with justification \c j. The type of v and m are inferred, and is_def_eq is invoked. Any constraint that contains \c m is revisited. \remark If relax is true then opaque definitions from the main module are treated as transparent. */ bool assign(expr const & m, expr const & v, justification const & j, bool relax, expr const & lhs, expr const & rhs) { lean_assert(is_metavar(m)); lean_assert(!in_conflict()); m_subst.assign(m, v, j); constraint_seq cs; auto lhs_type = infer(lhs, relax, cs); auto rhs_type = infer(rhs, relax, cs); if (lhs_type && rhs_type) { if (!process_constraints(cs, j)) return false; justification new_j = mk_assign_justification(m, *lhs_type, *rhs_type, j); if (!is_def_eq(*lhs_type, *rhs_type, new_j, relax)) return false; } else { set_conflict(j); return false; } auto it = m_mvar_occs.find(mlocal_name(m)); if (it) { cnstr_idx_set s = *it; m_mvar_occs.erase(mlocal_name(m)); s.for_each([&](unsigned cidx) { process_constraint_cidx(cidx); }); return !in_conflict(); } else { return true; } } /** \brief Assign \c v to universe metavariable \c m with justification \c j. Any constraint that contains \c m is revisted. */ bool assign(level const & m, level const & v, justification const & j) { lean_assert(is_meta(m)); m_subst.assign(m, v, j); return true; } justification mk_invalid_local_ctx_justification(expr const & lhs, expr const & rhs, justification const & j, expr const & bad_local) { justification new_j = mk_justification(get_app_fn(lhs), [=](formatter const & fmt, substitution const & subst) { format r = format("invalid local context when tried to assign"); r += pp_indent_expr(fmt, rhs); buffer locals; auto m = get_app_args(lhs, locals); r += line() + format("containing '") + fmt(bad_local) + format("', to placeholder '") + fmt(m) + format("'"); if (locals.empty()) { r += format(", in the empty local context"); } else { r += format(", in the local context"); format aux; bool first = true; for (expr const l : locals) { if (first) first = false; else aux += space(); aux += fmt(l); } r += nest(get_pp_indent(fmt.get_options()), compose(line(), aux)); } r += compose(line(), format("the assignment was attempted when trying to solve")); r += nest(2*get_pp_indent(fmt.get_options()), compose(line(), j.pp(fmt, nullptr, subst))); return r; }); return mk_composite1(new_j, j); } enum status { Solved, Failed, Continue }; /** \brief Process constraints of the form lhs =?= rhs where lhs is of the form ?m or (?m l_1 .... l_n), where all \c l_i are distinct local variables. In this case, the method returns Solved, if the method assign succeeds. The method returns \c Failed if \c rhs contains ?m, or it contains a local constant not in {l_1, ..., l_n}. Otherwise, it returns \c Continue. */ status process_metavar_eq(expr const & lhs, expr const & rhs, justification const & j, bool relax) { if (!is_meta(lhs)) return Continue; buffer locals; auto m = is_simple_meta(lhs, locals); if (!m || is_meta(rhs)) return Continue; expr bad_local; occurs_check_status status; if (m_config.m_ignore_context_check) status = occurs_check_status::Ok; else status = occurs_context_check(m_subst, rhs, *m, locals, bad_local); if (status == occurs_check_status::FailLocal || status == occurs_check_status::FailCircular) { // Try to normalize rhs // Example: ?M := f (pr1 (pair 0 ?M)) constraint_seq cs; auto is_target_fn = [&](expr const & e) { if (status == occurs_check_status::FailLocal && occurs(bad_local, e)) return true; else if (status == occurs_check_status::FailCircular && occurs(*m, e)) return true; return false; }; expr rhs_n = normalize(*m_tc[relax], rhs, is_target_fn, cs); if (rhs != rhs_n && process_constraints(cs)) return process_metavar_eq(lhs, rhs_n, j, relax); } switch (status) { case occurs_check_status::FailLocal: set_conflict(mk_invalid_local_ctx_justification(lhs, rhs, j, bad_local)); return Failed; case occurs_check_status::FailCircular: set_conflict(j); return Failed; case occurs_check_status::Maybe: return Continue; case occurs_check_status::Ok: lean_assert(!m_subst.is_assigned(*m)); if (assign(*m, Fun(locals, rhs), j, relax, lhs, rhs)) { return Solved; } else { return Failed; } } lean_unreachable(); // LCOV_EXCL_LINE } optional is_delta(expr const & e) { return ::lean::is_delta(m_env, e); } /** \brief Return true if lhs and rhs are of the form (f ...) where f can be expanded */ bool is_eq_deltas(expr const & lhs, expr const & rhs) { auto lhs_d = is_delta(lhs); auto rhs_d = is_delta(rhs); return lhs_d && rhs_d && is_eqp(*lhs_d, *rhs_d); } /** \brief Return true if the constraint is of the form (f ...) =?= (f ...), where f can be expanded. */ bool is_delta_cnstr(constraint const & c) { return is_eq_cnstr(c) && is_eq_deltas(cnstr_lhs_expr(c), cnstr_rhs_expr(c)); } pair instantiate_metavars(constraint const & c) { if (is_eq_cnstr(c)) { auto lhs_jst = m_subst.instantiate_metavars(cnstr_lhs_expr(c)); auto rhs_jst = m_subst.instantiate_metavars(cnstr_rhs_expr(c)); expr lhs = lhs_jst.first; expr rhs = rhs_jst.first; if (lhs != cnstr_lhs_expr(c) || rhs != cnstr_rhs_expr(c)) { return mk_pair(mk_eq_cnstr(lhs, rhs, mk_composite1(mk_composite1(c.get_justification(), lhs_jst.second), rhs_jst.second), relax_main_opaque(c)), true); } } else if (is_level_eq_cnstr(c)) { auto lhs_jst = m_subst.instantiate_metavars(cnstr_lhs_level(c)); auto rhs_jst = m_subst.instantiate_metavars(cnstr_rhs_level(c)); level lhs = lhs_jst.first; level rhs = rhs_jst.first; if (lhs != cnstr_lhs_level(c) || rhs != cnstr_rhs_level(c)) { return mk_pair(mk_level_eq_cnstr(lhs, rhs, mk_composite1(mk_composite1(c.get_justification(), lhs_jst.second), rhs_jst.second)), true); } } return mk_pair(c, false); } status process_eq_constraint_core(constraint const & c) { expr const & lhs = cnstr_lhs_expr(c); expr const & rhs = cnstr_rhs_expr(c); justification const & jst = c.get_justification(); bool relax = relax_main_opaque(c); if (lhs == rhs) return Solved; // trivial constraint // Update justification using the justification of the instantiated metavariables if (!has_metavar(lhs) && !has_metavar(rhs)) { return is_def_eq(lhs, rhs, jst, relax) ? Solved : Failed; } // Handle higher-order pattern matching. status st = process_metavar_eq(lhs, rhs, jst, relax); if (st != Continue) return st; st = process_metavar_eq(rhs, lhs, jst, relax); if (st != Continue) return st; return Continue; } expr instantiate_meta(expr e, justification & j) { while (true) { expr const & f = get_app_fn(e); if (!is_metavar(f)) return e; name const & f_name = mlocal_name(f); auto f_value = m_subst.get_expr(f_name); if (!f_value) return e; j = mk_composite1(j, m_subst.get_expr_jst(f_name)); buffer args; get_app_rev_args(e, args); e = apply_beta(*f_value, args.size(), args.data()); } } expr instantiate_meta_args(expr const & e, justification & j) { if (!is_app(e)) return e; buffer args; bool modified = false; expr const & f = get_app_rev_args(e, args); unsigned i = args.size(); while (i > 0) { --i; expr new_arg = instantiate_meta(args[i], j); if (new_arg != args[i]) { modified = true; args[i] = new_arg; } } if (!modified) return e; return mk_rev_app(f, args.size(), args.data()); } status instantiate_eq_cnstr(constraint const & c) { justification j = c.get_justification(); expr lhs = instantiate_meta(cnstr_lhs_expr(c), j); expr rhs = instantiate_meta(cnstr_rhs_expr(c), j); if (lhs != cnstr_lhs_expr(c) || rhs != cnstr_rhs_expr(c)) return is_def_eq(lhs, rhs, j, relax_main_opaque(c)) ? Solved : Failed; lhs = instantiate_meta_args(lhs, j); rhs = instantiate_meta_args(rhs, j); if (lhs != cnstr_lhs_expr(c) || rhs != cnstr_rhs_expr(c)) return is_def_eq(lhs, rhs, j, relax_main_opaque(c)) ? Solved : Failed; return Continue; } /** \brief Return a delay factor if e is of the form (?m ...) and ?m is a metavariable owned by a choice constraint. The delay factor is the delay of the choice constraint. Return none otherwise. */ optional is_owned(expr const & e) { expr const & m = get_app_fn(e); if (!is_metavar(m)) return optional(); if (auto it = m_owned_map.find(mlocal_name(m))) return optional(*it); else return optional(); } /** \brief Applies previous method to the left and right hand sides of the equality constraint */ optional is_owned(constraint const & c) { if (auto d = is_owned(cnstr_lhs_expr(c))) return d; else return is_owned(cnstr_rhs_expr(c)); } /** \brief Process an equality constraints. */ bool process_eq_constraint(constraint const & c) { lean_assert(is_eq_cnstr(c)); // instantiate assigned metavariables status st = instantiate_eq_cnstr(c); if (st != Continue) return st == Solved; if (auto d = is_owned(c)) { // Metavariable in the constraint is owned by choice constraint. // So, we postpone this constraint. add_cnstr(c, to_cnstr_group(*d+1)); return true; } st = process_eq_constraint_core(c); if (st != Continue) return st == Solved; expr const & lhs = cnstr_lhs_expr(c); expr const & rhs = cnstr_rhs_expr(c); bool relax = relax_main_opaque(c); if (is_eq_deltas(lhs, rhs)) { // we need to create a backtracking point for this one add_cnstr(c, cnstr_group::Basic); } else if (is_meta(lhs) && is_meta(rhs)) { // flex-flex constraints are delayed the most. unsigned cidx = add_cnstr(c, cnstr_group::FlexFlex); add_meta_occ(lhs, cidx); add_meta_occ(rhs, cidx); } else if (m_plugin->delay_constraint(*m_tc[relax], c)) { unsigned cidx = add_cnstr(c, cnstr_group::PluginDelayed); add_meta_occs(lhs, cidx); add_meta_occs(rhs, cidx); } else if (is_meta(lhs)) { // flex-rigid constraints are delayed. unsigned cidx = add_cnstr(c, cnstr_group::FlexRigid); add_meta_occ(lhs, cidx); } else if (is_meta(rhs)) { // flex-rigid constraints are delayed. unsigned cidx = add_cnstr(c, cnstr_group::FlexRigid); add_meta_occ(rhs, cidx); } else { // this constraints require the unifier plugin to be solved add_cnstr(c, cnstr_group::Basic); } return true; } /** \brief Process a universe level constraints of the form ?m =?= rhs. It fails if rhs contains \c ?m and is definitely bigger than \c ?m. TODO(Leo): we should improve this method in the future. It is doing only very basic things. */ status process_metavar_eq(level const & lhs, level const & rhs, justification const & j) { if (!is_meta(lhs)) return Continue; bool contains = occurs_meta(lhs, rhs); if (contains) { if (is_succ(rhs)) { set_conflict(j); return Failed; } else { return Continue; } } lean_assert(!m_subst.is_assigned(lhs)); if (assign(lhs, rhs, j)) { return Solved; } else { set_conflict(j); return Failed; } } /** \brief Process a universe level contraints. */ bool process_level_eq_constraint(constraint const & c) { lean_assert(is_level_eq_cnstr(c)); // instantiate assigned metavariables constraint new_c = instantiate_metavars(c).first; level lhs = cnstr_lhs_level(new_c); level rhs = cnstr_rhs_level(new_c); justification jst = new_c.get_justification(); // normalize lhs and rhs lhs = normalize(lhs); rhs = normalize(rhs); // eliminate outermost succs while (is_succ(lhs) && is_succ(rhs)) { lhs = succ_of(lhs); rhs = succ_of(rhs); } if (lhs == rhs) return true; // trivial constraint if (!has_meta(lhs) && !has_meta(rhs)) { set_conflict(jst); return false; // trivial failure } status st = process_metavar_eq(lhs, rhs, jst); if (st != Continue) return st == Solved; st = process_metavar_eq(rhs, lhs, jst); if (st != Continue) return st == Solved; if (lhs != cnstr_lhs_level(new_c) || rhs != cnstr_rhs_level(new_c)) new_c = mk_level_eq_cnstr(lhs, rhs, new_c.get_justification()); add_cnstr(new_c, cnstr_group::FlexRigid); return true; } bool preprocess_choice_constraint(constraint c) { if (!cnstr_on_demand(c)) { if (cnstr_is_owner(c)) { expr m = get_app_fn(cnstr_expr(c)); lean_assert(is_metavar(m)); m_owned_map.insert(mlocal_name(m), cnstr_delay_factor(c)); } add_cnstr(c, get_choice_cnstr_group(c)); return true; } else { expr m = cnstr_expr(c); // choice constraints that are marked as "on demand" // are only processed when all metavariables in the // type of m have been instantiated. expr type; justification jst; if (auto it = m_type_map.find(m)) { // Type of m is already cached in m_type_map type = it->first; jst = it->second; } else { // Type of m is not cached yet, we // should infer it, process generated // constraints and save the result in // m_type_map. bool relax = relax_main_opaque(c); constraint_seq cs; optional t = infer(m, relax, cs); if (!t) { set_conflict(c.get_justification()); return false; } if (!process_constraints(cs, c.get_justification())) return false; type = *t; m_type_map.insert(m, mk_pair(type, justification())); } // Try to instantiate metavariables in type pair type_jst = m_subst.instantiate_metavars(type); if (type_jst.first != type) { // Type was modified by instantiation, // we update the constraint justification, // and store the new type in m_type_map jst = mk_composite1(jst, type_jst.second); type = type_jst.first; c = update_justification(c, mk_composite1(c.get_justification(), jst)); m_type_map.insert(m, mk_pair(type, jst)); } unsigned cidx = add_cnstr(c, cnstr_group::ClassInstance); if (!add_meta_occs(type, cidx)) { // type does not contain metavariables... // so this "on demand" constraint is ready to be solved m_cnstrs.erase(cnstr(c, cidx)); add_cnstr(c, cnstr_group::Basic); m_type_map.erase(m); } return true; } } /** \brief Process the given constraint \c c. "Easy" constraints are solved, and the remaining ones are added to the constraint queue m_cnstrs. By "easy", see the methods #process_eq_constraint and #process_level_eq_constraint. */ bool process_constraint(constraint const & c) { if (in_conflict()) return false; check_system(); // std::cout << "process: " << c << "\n"; switch (c.kind()) { case constraint_kind::Choice: return preprocess_choice_constraint(c); case constraint_kind::Eq: return process_eq_constraint(c); case constraint_kind::LevelEq: return process_level_eq_constraint(c); } lean_unreachable(); // LCOV_EXCL_LINE } /** \brief Process constraint with index \c cidx. The constraint is removed from the constraint queue, and the method #process_constraint is invoked. */ bool process_constraint_cidx(unsigned cidx) { if (in_conflict()) return false; cnstr c(*g_dont_care_cnstr, cidx); if (auto it = m_cnstrs.find(c)) { constraint c2 = it->first; m_cnstrs.erase(c); return process_constraint(c2); } return true; } void add_case_split(std::unique_ptr && cs) { m_case_splits.push_back(std::move(cs)); } // This method is used only for debugging purposes. void display(std::ostream & out, justification const & j, unsigned indent = 0) { for (unsigned i = 0; i < indent; i++) out << " "; out << j.pp(mk_print_formatter_factory()(m_env, options()), nullptr, m_subst) << "\n"; if (j.is_composite()) { display(out, composite_child1(j), indent+2); display(out, composite_child2(j), indent+2); } } void pop_case_split() { m_case_splits.pop_back(); } bool resolve_conflict() { lean_assert(in_conflict()); while (!m_case_splits.empty()) { justification conflict = *m_conflict; std::unique_ptr & d = m_case_splits.back(); if (depends_on(conflict, d->m_assumption_idx)) { d->m_failed_justifications = mk_composite1(d->m_failed_justifications, conflict); if (d->next(*this)) { reset_conflict(); return true; } } else { pop_case_split(); } } return false; } bool next_lazy_constraints_case_split(lazy_constraints_case_split & cs) { auto r = cs.m_tail.pull(); if (r) { cs.restore_state(*this); lean_assert(!in_conflict()); cs.m_tail = r->second; return process_constraints(r->first, mk_composite1(cs.get_jst(), mk_assumption_justification(cs.m_assumption_idx))); } else { // update conflict update_conflict(mk_composite1(*m_conflict, cs.m_failed_justifications)); pop_case_split(); return false; } } bool process_lazy_constraints(lazy_list const & l, justification const & j) { auto r = l.pull(); if (r) { if (r->second.is_nil()) { // there is only one alternative return process_constraints(r->first, j); } else { justification a = mk_assumption_justification(m_next_assumption_idx); add_case_split(std::unique_ptr(new lazy_constraints_case_split(*this, j, r->second))); return process_constraints(r->first, mk_composite1(j, a)); } } else { set_conflict(j); return false; } } /** \brief Given a constraint of the form f a_1 ... a_n =?= f b_1 ... b_n Return singleton stream with the possible solution a_i =?= b_i If c is not of the expected form, then return the empty stream. */ lazy_list process_const_const_cnstr(constraint const & c) { if (!is_eq_cnstr(c)) return lazy_list(); expr const & lhs = cnstr_lhs_expr(c); expr const & rhs = cnstr_rhs_expr(c); expr const & f_lhs = get_app_fn(lhs); expr const & f_rhs = get_app_fn(rhs); if (!is_constant(f_lhs) || !is_constant(f_rhs) || const_name(f_lhs) != const_name(f_rhs)) return lazy_list(); justification const & j = c.get_justification(); constraint_seq cs; bool relax = relax_main_opaque(c); auto fcs = m_tc[relax]->is_def_eq(f_lhs, f_rhs, j); if (!fcs.first) return lazy_list(); cs = fcs.second; buffer args_lhs, args_rhs; get_app_args(lhs, args_lhs); get_app_args(rhs, args_rhs); if (args_lhs.size() != args_rhs.size()) return lazy_list(); for (unsigned i = 0; i < args_lhs.size(); i++) { auto acs = m_tc[relax]->is_def_eq(args_lhs[i], args_rhs[i], j); if (!acs.first) return lazy_list(); cs = acs.second + cs; } return lazy_list(cs.to_list()); } bool process_plugin_constraint(constraint const & c) { bool relax = relax_main_opaque(c); lean_assert(!is_choice_cnstr(c)); lazy_list alts = m_plugin->solve(*m_tc[relax], c, m_ngen.mk_child()); alts = append(alts, process_const_const_cnstr(c)); return process_lazy_constraints(alts, c.get_justification()); } bool process_choice_constraint(constraint const & c) { lean_assert(is_choice_cnstr(c)); expr const & m = cnstr_expr(c); choice_fn const & fn = cnstr_choice_fn(c); if (cnstr_is_owner(c)) { // choice will have a chance to assign m, so // we remove the "barrier" that was preventing m from being assigned. m_owned_map.erase(mlocal_name(get_app_fn(m))); } expr m_type; bool relax = relax_main_opaque(c); constraint_seq cs; if (auto type = infer(m, relax, cs)) { m_type = *type; if (!process_constraints(cs)) return false; } else { set_conflict(c.get_justification()); return false; } auto m_type_jst = m_subst.instantiate_metavars(m_type); lazy_list alts = fn(m, m_type_jst.first, m_subst, m_ngen.mk_child()); return process_lazy_constraints(alts, mk_composite1(c.get_justification(), m_type_jst.second)); } bool next_simple_case_split(simple_case_split & cs) { if (!is_nil(cs.m_tail)) { cs.restore_state(*this); lean_assert(!in_conflict()); constraints c = head(cs.m_tail); cs.m_tail = tail(cs.m_tail); return process_constraints(c, mk_composite1(cs.get_jst(), mk_assumption_justification(cs.m_assumption_idx))); } else { // update conflict update_conflict(mk_composite1(*m_conflict, cs.m_failed_justifications)); pop_case_split(); return false; } } bool next_delta_unfold_case_split(delta_unfold_case_split & cs) { if (!cs.m_done) { cs.restore_state(*this); cs.m_done = true; constraint const & c = cs.m_cnstr; expr const & lhs = cnstr_lhs_expr(c); expr const & rhs = cnstr_rhs_expr(c); buffer lhs_args, rhs_args; justification j = c.get_justification(); expr lhs_fn = get_app_rev_args(lhs, lhs_args); expr rhs_fn = get_app_rev_args(rhs, rhs_args); declaration d = *m_env.find(const_name(lhs_fn)); levels lhs_lvls = const_levels(lhs_fn); levels rhs_lvls = const_levels(lhs_fn); bool relax = relax_main_opaque(c); expr lhs_fn_val = instantiate_value_univ_params(d, const_levels(lhs_fn)); expr rhs_fn_val = instantiate_value_univ_params(d, const_levels(rhs_fn)); expr t = apply_beta(lhs_fn_val, lhs_args.size(), lhs_args.data()); expr s = apply_beta(rhs_fn_val, rhs_args.size(), rhs_args.data()); auto dcs = m_tc[relax]->is_def_eq(t, s, j); if (dcs.first) { constraints cnstrs = dcs.second.to_list(); return process_constraints(cnstrs, mk_composite1(cs.get_jst(), mk_assumption_justification(cs.m_assumption_idx))); } else { set_conflict(j); return false; } } else { // update conflict update_conflict(mk_composite1(*m_conflict, cs.m_failed_justifications)); pop_case_split(); return false; } } /** \brief Solve constraints of the form (f a_1 ... a_n) =?= (f b_1 ... b_n) where f can be expanded. We consider two possible solutions: 1) a_1 =?= b_1, ..., a_n =?= b_n 2) t =?= s, where t and s are the terms we get after expanding f */ bool process_delta(constraint const & c) { lean_assert(is_delta_cnstr(c)); expr const & lhs = cnstr_lhs_expr(c); expr const & rhs = cnstr_rhs_expr(c); buffer lhs_args, rhs_args; justification j = c.get_justification(); expr lhs_fn = get_app_rev_args(lhs, lhs_args); expr rhs_fn = get_app_rev_args(rhs, rhs_args); declaration d = *m_env.find(const_name(lhs_fn)); levels lhs_lvls = const_levels(lhs_fn); levels rhs_lvls = const_levels(lhs_fn); if (lhs_args.size() != rhs_args.size() || length(lhs_lvls) != length(rhs_lvls) || length(d.get_univ_params()) != length(lhs_lvls)) { // the constraint is not well-formed, this can happen when users are abusing the API return false; } justification a; bool relax = relax_main_opaque(c); if (!m_config.m_cheap && (m_config.m_computation || module::is_definition(m_env, d.get_name()) || is_reducible_on(m_env, d.get_name()))) { // add case_split for t =?= s a = mk_assumption_justification(m_next_assumption_idx); add_case_split(std::unique_ptr(new delta_unfold_case_split(*this, j, c))); } // process first case justification new_j = mk_composite1(j, a); while (!is_nil(lhs_lvls)) { level lhs = head(lhs_lvls); level rhs = head(rhs_lvls); if (!process_constraint(mk_level_eq_cnstr(lhs, rhs, new_j))) return false; lhs_lvls = tail(lhs_lvls); rhs_lvls = tail(rhs_lvls); } unsigned i = lhs_args.size(); while (i > 0) { --i; if (!is_def_eq(lhs_args[i], rhs_args[i], new_j, relax)) return false; } return true; } /** \brief Return true iff \c c is a flex-rigid constraint. */ static bool is_flex_rigid(constraint const & c) { if (!is_eq_cnstr(c)) return false; bool is_lhs_meta = is_meta(cnstr_lhs_expr(c)); bool is_rhs_meta = is_meta(cnstr_rhs_expr(c)); return is_lhs_meta != is_rhs_meta; } /** \brief Return true iff \c c is a flex-flex constraint */ static bool is_flex_flex(constraint const & c) { return is_eq_cnstr(c) && is_meta(cnstr_lhs_expr(c)) && is_meta(cnstr_rhs_expr(c)); } /** \brief Append the auxiliary constraints \c aux to each alternative in \c alts */ void append_auxiliary_constraints(buffer & alts, list const & aux) { if (is_nil(aux)) return; for (constraints & cs : alts) cs = append(aux, cs); } /** \brief Auxiliary functional object for implementing process_flex_rigid_core */ class flex_rigid_core_fn { unifier_fn & u; expr const & lhs; buffer margs; expr const & m; expr const & rhs; justification j; bool relax; buffer & alts; // result: alternatives optional _has_meta_args; bool cheap() const { return u.m_config.m_cheap; } type_checker & tc() { return *u.m_tc[relax]; } type_checker & restricted_tc() { if (u.m_config.m_computation) return *u.m_tc[relax]; else return *u.m_flex_rigid_tc[relax]; } /** \brief Return true if margs contains an expression \c e s.t. is_meta(e) */ bool has_meta_args() { if (!_has_meta_args) { _has_meta_args = std::any_of(margs.begin(), margs.end(), [](expr const & e) { return is_meta(e); }); } return *_has_meta_args; } /** \brief Given t Pi (x_1 : A_1) ... (x_n : A_n[x_1, ..., x_{n-1}]), B[x_1, ..., x_n] return fun (x_1 : A_1) ... (x_n : A_n[x_1, ..., x_{n-1}]), v[x_1, ... x_n] \remark v has free variables. */ expr mk_lambda_for(unsigned i, expr const & t, expr const & v) { if (i < margs.size()) { return mk_lambda(binding_name(t), binding_domain(t), mk_lambda_for(i+1, binding_body(t), v), binding_info(t)); } else { return v; } } expr mk_lambda_for(expr const & t, expr const & v) { return mk_lambda_for(0, t, v); } /** \brief Return true if \c local occurs once in the buffer \c es. */ bool local_occurs_once(expr const & local, buffer const & es) { bool found = false; for (expr const & e : es) { if (is_local(e) && mlocal_name(e) == mlocal_name(local)) { if (found) return false; found = true; } } return true; } /** \see ensure_sufficient_args */ expr ensure_sufficient_args_core(expr mtype, unsigned i, constraint_seq & cs) { if (i == margs.size()) return mtype; mtype = tc().ensure_pi(mtype, cs); expr local = u.mk_local_for(mtype); expr body = instantiate(binding_body(mtype), local); return Pi(local, ensure_sufficient_args_core(body, i+1, cs)); } /** \brief Make sure mtype is a Pi of size at least margs.size(). If it is not, we use ensure_pi and (potentially) add new constaints to enforce it. */ expr ensure_sufficient_args(expr const & mtype, constraint_seq & cs) { expr t = mtype; unsigned num = 0; while (is_pi(t)) { num++; t = binding_body(t); } if (num >= margs.size()) return mtype; return ensure_sufficient_args_core(mtype, 0, cs); } /** \brief Given m := a metavariable ?m rhs := sort, constant Then solve (?m a_1 ... a_k) =?= rhs, by returning the constraint ?m =?= fun (x1 ... x_k), rhs */ void mk_simple_imitation() { lean_assert(is_metavar(m)); lean_assert(is_sort(rhs) || is_constant(rhs)); expr const & mtype = mlocal_type(m); constraint_seq cs; expr new_mtype = ensure_sufficient_args(mtype, cs); cs = cs + mk_eq_cnstr(m, mk_lambda_for(new_mtype, rhs), j, relax); alts.push_back(cs.to_list()); } bool restricted_is_def_eq(expr const & marg, expr const & rhs, justification const & j, constraint_seq & cs) { try { if (restricted_tc().is_def_eq(marg, rhs, j, cs)) { return true; } else { return false; } } catch (exception & ex) { return false; } } /** Given, m := a metavariable ?m margs := [a_1 ... a_k] We say a unification problem (?m a_1 ... a_k) =?= rhs uses "simple nonlocal i-th projection" when 1) rhs is not a local constant 2) is_def_eq(a_i, rhs) does not fail In this case, we add a_i =?= rhs ?m =?= fun x_1 ... x_k, x_i to alts as a possible solution. */ void mk_simple_nonlocal_projection(unsigned i) { expr const & mtype = mlocal_type(m); unsigned vidx = margs.size() - i - 1; expr const & marg = margs[i]; constraint_seq cs; auto new_mtype = ensure_sufficient_args(mtype, cs); // Remark: we should not use mk_eq_cnstr(marg, rhs, j) since is_def_eq may be able to reduce them. // The unifier assumes the eq constraints are reduced. if (tc().is_def_eq_types(marg, rhs, j, cs) && restricted_is_def_eq(marg, rhs, j, cs)) { expr v = mk_lambda_for(new_mtype, mk_var(vidx)); cs = cs + mk_eq_cnstr(m, v, j, relax); alts.push_back(cs.to_list()); } } /** Given, m := a metavariable ?m margs := [a_1 ... a_k] We say a unification problem (?m a_1 ... a_k) =?= rhs uses "simple projections" when If (rhs and a_i are *not* local constants) OR (rhs is a local constant and a_i is a metavariable application), then we add the constraints a_i =?= rhs ?m =?= fun x_1 ... x_k, x_i to alts as a possible solution. If rhs is a local constant and a_i == rhs, then we add the constraint ?m =?= fun x_1 ... x_k, x_i to alts as a possible solution when a_i is the same local constant or a metavariable application */ void mk_simple_projections() { lean_assert(is_metavar(m)); lean_assert(!is_meta(rhs)); expr const & mtype = mlocal_type(m); unsigned i = margs.size(); while (i > 0) { unsigned vidx = margs.size() - i; --i; expr const & marg = margs[i]; if ((!is_local(marg) && !is_local(rhs)) || (is_meta(marg) && is_local(rhs))) { // if rhs is not local, then we only add projections for the nonlocal arguments of lhs mk_simple_nonlocal_projection(i); if (cheap()) return; } else if (is_local(marg) && is_local(rhs) && mlocal_name(marg) == mlocal_name(rhs)) { // if the argument is local, and rhs is equal to it, then we also add a projection constraint_seq cs; auto new_mtype = ensure_sufficient_args(mtype, cs); expr v = mk_lambda_for(new_mtype, mk_var(vidx)); cs = cs + mk_eq_cnstr(m, v, j, relax); alts.push_back(cs.to_list()); if (cheap()) return; } } } /** \see mk_flex_rigid_app_cnstrs When using "imitation" for solving a constraint ?m l_1 ... l_k =?= f a_1 ... a_n We say argument a_i is "easy" if 1) it is a local constant 2) there is only one l_j equal to a_i. 3) none of the l_j's is of the form (?m ...) In our experiments, the vast majority (> 2/3 of all cases) of the arguments are easy. margs contains l_1 ... l_k arg is the argument we are testing Result: none if it is not an easy argument, and variable #k-i-1 if it is easy. The variable is the "solution". */ optional is_easy_flex_rigid_arg(expr const & arg) { if (!is_local(arg)) return none_expr(); optional v; unsigned num_margs = margs.size(); for (unsigned j = 0; j < num_margs; j++) { if (is_meta(margs[j])) return none_expr(); if (is_local(margs[j]) && mlocal_name(arg) == mlocal_name(margs[j])) { if (v) return none_expr(); // failed, there is more than one possibility v = mk_var(num_margs - j - 1); } } return v; } void mk_app_projections() { lean_assert(is_metavar(m)); lean_assert(is_app(rhs)); if (!u.m_pattern && !cheap()) { expr const & f = get_app_fn(rhs); lean_assert(is_constant(f) || is_local(f)); if (is_local(f)) { unsigned i = margs.size(); while (i > 0) { --i; if (!(is_local(margs[i]) && mlocal_name(margs[i]) == mlocal_name(f))) mk_simple_nonlocal_projection(i); } } else { mk_simple_projections(); } } } /** \brief Create the local context \c locals for the imitiation step. */ void mk_local_context(buffer & locals, constraint_seq & cs) { expr mtype = mlocal_type(m); unsigned nargs = margs.size(); mtype = ensure_sufficient_args(mtype, cs); expr it = mtype; for (unsigned i = 0; i < nargs; i++) { expr d = instantiate_rev(binding_domain(it), locals.size(), locals.data()); auto d_jst = u.m_subst.instantiate_metavars(d); d = d_jst.first; j = mk_composite1(j, d_jst.second); name n; if (is_local(margs[i]) && local_occurs_once(margs[i], margs)) { n = mlocal_name(margs[i]); } else { n = u.m_ngen.next(); } expr local = mk_local(n, binding_name(it), d, binding_info(it)); locals.push_back(local); it = binding_body(it); } } expr mk_imitiation_arg(expr const & arg, expr const & type, buffer const & locals, constraint_seq & cs) { // The following optimization is broken. It does not really work when we have dependent // types. The problem is that the type of arg may depend on other arguments, // and constraints are not generated to enforce it. // // Here is a minimal counterexample // ?M A B a b H B b =?= heq.type_eq A B a b H // with this optimization the imitation is // // ?M := fun (A B a b H B' b'), heq.type_eq A (?M1 A B a b H B' b') a (?M2 A B a b H B' b') H // // This imitation is only correct if // typeof(H) is (heq A a (?M1 A B a b H B' b') (?M2 A B a b H B' b')) // // Adding an extra constraint is problematic since typeof(H) may contain local constants, // and these local constants may have been "renamed" by mk_local_context above // // For now, we simply comment the optimization. // // Broken optimization // if (!has_meta_args() && is_local(arg) && contains_local(arg, locals)) { // return arg; // } // The following code is not affected by the problem above because we // attach the type \c type to the new metavariables being created. // std::cout << "type: " << type << "\n"; if (context_check(type, locals)) { expr maux = mk_metavar(u.m_ngen.next(), Pi(locals, type)); // std::cout << " >> " << maux << " : " << mlocal_type(maux) << "\n"; cs = mk_eq_cnstr(mk_app(maux, margs), arg, j, relax) + cs; return mk_app(maux, locals); } else { expr maux_type = mk_metavar(u.m_ngen.next(), Pi(locals, mk_sort(mk_meta_univ(u.m_ngen.next())))); expr maux = mk_metavar(u.m_ngen.next(), Pi(locals, mk_app(maux_type, locals))); cs = mk_eq_cnstr(mk_app(maux, margs), arg, j, relax) + cs; return mk_app(maux, locals); } } void mk_app_imitation_core(expr const & f, buffer const & locals, constraint_seq & cs) { buffer rargs; get_app_args(rhs, rargs); buffer sargs; try { expr f_type = tc().infer(f, cs); for (expr const & rarg : rargs) { f_type = tc().ensure_pi(f_type, cs); expr d_type = binding_domain(f_type); expr sarg = mk_imitiation_arg(rarg, d_type, locals, cs); sargs.push_back(sarg); f_type = instantiate(binding_body(f_type), sarg); } } catch (exception&) {} expr v = Fun(locals, mk_app(f, sargs)); cs += mk_eq_cnstr(m, v, j, relax); alts.push_back(cs.to_list()); } /** \brief Given m := a metavariable ?m margs := [a_1 ... a_k] rhs := (f b_1 ... b_n) Then create the constraints (?m_1 a_1 ... a_k) =?= b_1 ... (?m_n a_1 ... a_k) =?= b_n ?m =?= fun (x_1 ... x_k), g (?m_1 x_1 ... x_k) ... (?m_n x_1 ... x_k) If f is a constant, then g is f. If f is a local constant, then we consider each a_i that is equal to f. Remark: we try to minimize the number of constraints (?m_i a_1 ... a_k) =?= b_i by detecting "easy" cases that can be solved immediately. See \c mk_imitiation_arg */ void mk_app_imitation() { lean_assert(is_metavar(m)); lean_assert(is_app(rhs)); buffer locals; constraint_seq cs; flet let(j, j); // save j value mk_local_context(locals, cs); lean_assert(margs.size() == locals.size()); expr const & f = get_app_fn(rhs); lean_assert(is_constant(f) || is_local(f)); if (is_local(f)) { unsigned i = margs.size(); while (i > 0) { --i; if (is_local(margs[i]) && mlocal_name(margs[i]) == mlocal_name(f)) { constraint_seq new_cs = cs; mk_app_imitation_core(locals[i], locals, new_cs); } } } else { mk_app_imitation_core(f, locals, cs); } } /** \brief Given m := a metavariable ?m margs := [a_1 ... a_k] rhs := (fun/Pi (y : A), B y) Then create the constraints (?m_1 a_1 ... a_k) =?= A (?m_2 a_1 ... a_k l) =?= B l ?m =?= fun (x_1 ... x_k), fun/Pi (y : ?m_1 x_1 ... x_k), ?m_2 x_1 ... x_k y where l is a fresh local constant. */ void mk_bindings_imitation() { lean_assert(is_metavar(m)); lean_assert(is_binding(rhs)); constraint_seq cs; buffer locals; flet let(j, j); // save j value mk_local_context(locals, cs); lean_assert(margs.size() == locals.size()); try { // create a scope to make sure no constraints "leak" into the current state expr rhs_A = binding_domain(rhs); expr A_type = tc().infer(rhs_A, cs); expr A = mk_imitiation_arg(rhs_A, A_type, locals, cs); expr local = mk_local(u.m_ngen.next(), binding_name(rhs), A, binding_info(rhs)); locals.push_back(local); margs.push_back(local); expr rhs_B = instantiate(binding_body(rhs), local); expr B_type = tc().infer(rhs_B, cs); expr B = mk_imitiation_arg(rhs_B, B_type, locals, cs); expr binding = is_pi(rhs) ? Pi(local, B) : Fun(local, B); locals.pop_back(); expr v = Fun(locals, binding); cs += mk_eq_cnstr(m, v, j, relax); alts.push_back(cs.to_list()); } catch (exception&) {} margs.pop_back(); } public: flex_rigid_core_fn(unifier_fn & _u, expr const & _lhs, expr const & _rhs, justification const & _j, bool _relax, buffer & _alts): u(_u), lhs(_lhs), m(get_app_args(lhs, margs)), rhs(_rhs), j(_j), relax(_relax), alts(_alts) {} void operator()() { switch (rhs.kind()) { case expr_kind::Var: case expr_kind::Meta: lean_unreachable(); // LCOV_EXCL_LINE case expr_kind::Local: mk_simple_projections(); break; case expr_kind::Sort: case expr_kind::Constant: if (!u.m_pattern && !cheap()) mk_simple_projections(); mk_simple_imitation(); break; case expr_kind::Pi: case expr_kind::Lambda: if (!u.m_pattern && !cheap()) mk_simple_projections(); mk_bindings_imitation(); break; case expr_kind::Macro: lean_unreachable(); // LCOV_EXCL_LINE case expr_kind::App: mk_app_projections(); mk_app_imitation(); break; } } }; void process_flex_rigid_core(expr const & lhs, expr const & rhs, justification const & j, bool relax, buffer & alts) { flex_rigid_core_fn(*this, lhs, rhs, j, relax, alts)(); } /** \brief When lhs is an application (f ...), make sure that if any argument that is reducible to a local constant is replaced with a local constant. \remark We store auxiliary constraints created in the reductions in \c aux. We return the new "reduce" application. \remark We need this step because of the optimization based on is_easy_flex_rigid_arg */ expr expose_local_args(expr const & lhs, justification const & j, bool relax, buffer & aux) { buffer margs; expr m = get_app_args(lhs, margs); bool modified = false; for (expr & marg : margs) { // Make sure that if marg is reducible to a local constant, then it is replaced with it. // We need that because of the optimization based on is_easy_flex_rigid_arg if (!is_local(marg)) { expr new_marg = whnf(marg, j, relax, aux); if (is_local(new_marg)) { marg = new_marg; modified = true; } } } return modified ? mk_app(m, margs) : lhs; } optional expand_rhs(expr const & rhs, bool relax) { buffer args; expr const & f = get_app_rev_args(rhs, args); lean_assert(!is_local(f) && !is_constant(f) && !is_var(f) && !is_metavar(f)); if (is_lambda(f)) { return some_expr(apply_beta(f, args.size(), args.data())); } else if (is_macro(f)) { if (optional new_f = m_tc[relax]->expand_macro(f)) return some_expr(mk_rev_app(*new_f, args.size(), args.data())); } return none_expr(); } /** \brief When solving flex-rigid constraints lhs =?= rhs (lhs is of the form ?M a_1 ... a_n), we consider an additional case-split where rhs is put in weak-head-normal-form when 1- Option unifier.computation is true 2- At least one a_i is not a local constant 3- rhs contains a local constant that is not equal to any a_i. */ bool use_flex_rigid_whnf_split(expr const & lhs, expr const & rhs) { lean_assert(is_meta(lhs)); if (m_config.m_cheap) return false; if (m_config.m_computation) return true; // if unifier.computation is true, we always consider the additional whnf split buffer locals; expr const * it = &lhs; while (is_app(*it)) { expr const & arg = app_arg(*it); if (!is_local(arg)) return true; // lhs contains non-local constant locals.push_back(arg); it = &(app_fn(*it)); } if (!context_check(rhs, locals)) return true; // rhs contains local constant that is not in locals return false; } /** \brief Process a flex rigid constraint */ bool process_flex_rigid(expr lhs, expr const & rhs, justification const & j, bool relax) { lean_assert(is_meta(lhs)); lean_assert(!is_meta(rhs)); if (is_app(rhs)) { expr const & f = get_app_fn(rhs); if (!is_local(f) && !is_constant(f)) { if (auto new_rhs = expand_rhs(rhs, relax)) { lean_assert(*new_rhs != rhs); return is_def_eq(lhs, *new_rhs, j, relax); } else { return false; } } } else if (is_macro(rhs)) { if (auto new_rhs = expand_rhs(rhs, relax)) { lean_assert(*new_rhs != rhs); return is_def_eq(lhs, *new_rhs, j, relax); } else { return false; } } buffer aux; lhs = expose_local_args(lhs, j, relax, aux); buffer alts; process_flex_rigid_core(lhs, rhs, j, relax, alts); append_auxiliary_constraints(alts, to_list(aux.begin(), aux.end())); if (use_flex_rigid_whnf_split(lhs, rhs)) { expr rhs_whnf = flex_rigid_whnf(rhs, j, relax, aux); if (rhs_whnf != rhs) { if (is_meta(rhs_whnf)) { // it become a flex-flex constraint alts.push_back(constraints(mk_eq_cnstr(lhs, rhs_whnf, j, relax))); } else { buffer alts2; process_flex_rigid_core(lhs, rhs_whnf, j, relax, alts2); append_auxiliary_constraints(alts2, to_list(aux.begin(), aux.end())); alts.append(alts2); } } } // std::cout << "FlexRigid\n"; // for (auto cs : alts) { // std::cout << " alternative\n"; // for (auto c : cs) { // std::cout << " >> " << c << "\n"; // } // } if (alts.empty()) { set_conflict(j); return false; } else if (alts.size() == 1) { // we don't need to create a backtracking point return process_constraints(alts[0], justification()); } else { justification a = mk_assumption_justification(m_next_assumption_idx); add_case_split(std::unique_ptr(new simple_case_split(*this, j, to_list(alts.begin() + 1, alts.end())))); return process_constraints(alts[0], a); } } /** \brief Process a flex rigid constraint */ bool process_flex_rigid(constraint const & c) { lean_assert(is_flex_rigid(c)); expr lhs = cnstr_lhs_expr(c); expr rhs = cnstr_rhs_expr(c); bool relax = relax_main_opaque(c); if (is_meta(lhs)) return process_flex_rigid(lhs, rhs, c.get_justification(), relax); else return process_flex_rigid(rhs, lhs, c.get_justification(), relax); } void discard(constraint const & c) { if (!m_config.m_discard) m_postponed = cons(c, m_postponed); } bool process_flex_flex(constraint const & c) { expr const & lhs = cnstr_lhs_expr(c); expr const & rhs = cnstr_rhs_expr(c); // We ignore almost all flex-flex constraints. // We just handle flex_flex "first-order" case // ?M_1 l_1 ... l_k =?= ?M_2 l_1 ... l_k if (!is_simple_meta(lhs) || !is_simple_meta(rhs)) { discard(c); return true; } buffer lhs_args, rhs_args; expr ml = get_app_args(lhs, lhs_args); expr mr = get_app_args(rhs, rhs_args); if (ml == mr || lhs_args.size() != rhs_args.size()) { discard(c); return true; } lean_assert(!m_subst.is_assigned(ml)); lean_assert(!m_subst.is_assigned(mr)); unsigned i = 0; for (; i < lhs_args.size(); i++) if (mlocal_name(lhs_args[i]) != mlocal_name(rhs_args[i])) break; if (i == lhs_args.size()) { return assign(ml, mr, c.get_justification(), relax_main_opaque(c), lhs, rhs); } else { discard(c); return true; } } /** \brief Return true iff \c rhs is of the form max(l_1 ... lhs ... l_k) , such that l_i's do not contain lhs. If the result is true, then all l_i's are stored in rest. */ static bool generalized_check_meta(level const & m, level const & rhs, bool & found_m, buffer & rest) { lean_assert(is_meta(m)); if (is_max(rhs)) { return generalized_check_meta(m, max_lhs(rhs), found_m, rest) && generalized_check_meta(m, max_rhs(rhs), found_m, rest); } else if (m == rhs) { found_m = true; return true; } else if (occurs_meta(m, rhs)) { return false; } else { rest.push_back(rhs); return true; } } status process_l_eq_max_core(level const & lhs, level const & rhs, justification const & jst) { lean_assert(is_meta(lhs)); buffer rest; bool found_lhs = false; if (generalized_check_meta(lhs, rhs, found_lhs, rest)) { level r; if (found_lhs) { // rhs is of the form max(rest, lhs) // Solution is lhs := max(rest, ?u) where ?u is fresh metavariable r = mk_meta_univ(m_ngen.next()); rest.push_back(r); unsigned i = rest.size(); while (i > 0) { --i; r = mk_max(rest[i], r); } r = normalize(r); } else { // lhs does not occur in rhs r = rhs; } if (assign(lhs, r, jst)) { return Solved; } else { set_conflict(jst); return Failed; } } else { return Continue; } } /** \brief Return solved iff \c c is a constraint of the form lhs =?= max(rest, lhs) and is successfully solved. */ status process_l_eq_max(constraint const & c) { lean_assert(is_level_eq_cnstr(c)); level lhs = cnstr_lhs_level(c); level rhs = cnstr_rhs_level(c); justification jst = c.get_justification(); if (is_meta(lhs)) return process_l_eq_max_core(lhs, rhs, jst); else if (is_meta(rhs)) return process_l_eq_max_core(rhs, lhs, jst); else return Continue; } /** Auxiliary method for process_succ_eq_max */ status process_succ_eq_max_core(level const & lhs, level const & rhs, justification const & jst) { if (!is_succ(lhs) || !is_max(rhs)) return Continue; level m = rhs; while (is_max(m)) { level m1 = max_lhs(m); level m2 = max_rhs(m); if (is_geq(lhs, m1)) { m = m2; } else if (is_geq(lhs, m2)) { m = m1; } else { return Continue; } } if (!is_meta(m)) return Continue; if (assign(m, lhs, jst)) { return Solved; } else { set_conflict(jst); return Failed; } } /** \brief Return Solved iff \c c is a constraint of the form succ^k_1 a =?= max(succ^k_2 b, ?m) where k_1 >= k_2 and a == b or b == zero and is successfully solved by assigning ?m := succ^k_1 a */ status process_succ_eq_max(constraint const & c) { lean_assert(is_level_eq_cnstr(c)); level lhs = cnstr_lhs_level(c); level rhs = cnstr_rhs_level(c); justification jst = c.get_justification(); status st = process_succ_eq_max_core(lhs, rhs, jst); if (st != Continue) return st; return process_succ_eq_max_core(rhs, lhs, jst); } /** \brief Process the following constraints 1. (max l1 l2) =?= 0 OR solution: l1 =?= 0, l2 =?= 0 2. (imax l1 l2) =?= 0 solution: l2 =?= 0 */ status try_level_eq_zero(level const & lhs, level const & rhs, justification const & j) { if (!is_zero(rhs)) return Continue; if (is_max(lhs)) { if (process_constraint(mk_level_eq_cnstr(max_lhs(lhs), rhs, j)) && process_constraint(mk_level_eq_cnstr(max_rhs(lhs), rhs, j))) return Solved; else return Failed; } else if (is_imax(lhs)) { return process_constraint(mk_level_eq_cnstr(imax_rhs(lhs), rhs, j)) ? Solved : Failed; } else { return Continue; } } status try_level_eq_zero(constraint const & c) { lean_assert(is_level_eq_cnstr(c)); level const & lhs = cnstr_lhs_level(c); level const & rhs = cnstr_rhs_level(c); justification const & j = c.get_justification(); status st = try_level_eq_zero(lhs, rhs, j); if (st != Continue) return st; return try_level_eq_zero(rhs, lhs, j); } /** \brief Try to solve constraints of the form (?m1 =?= max ?m2 ?m3) (?m1 =?= max ?m2 ?m3) by assigning ?m1 =?= ?m2 and ?m1 =?= ?m3 \remark we may miss solutions. */ status try_merge_max_core(level const & lhs, level const & rhs, justification const & j) { level m1 = lhs; level m2, m3; if (is_max(rhs)) { m2 = max_lhs(rhs); m3 = max_rhs(rhs); } else if (is_imax(rhs)) { m2 = imax_lhs(rhs); m3 = imax_rhs(rhs); } else { return Continue; } if (process_constraint(mk_level_eq_cnstr(m1, m2, j)) && process_constraint(mk_level_eq_cnstr(m1, m3, j))) return Solved; else return Failed; } /** \see try_merge_max_core */ status try_merge_max(constraint const & c) { lean_assert(is_level_eq_cnstr(c)); level const & lhs = cnstr_lhs_level(c); level const & rhs = cnstr_rhs_level(c); justification const & j = c.get_justification(); status st = try_merge_max_core(lhs, rhs, j); if (st != Continue) return st; return try_merge_max_core(rhs, lhs, j); } /** \brief Process the next constraint in the constraint queue m_cnstrs */ bool process_next() { lean_assert(!m_cnstrs.empty()); auto const * p = m_cnstrs.min(); unsigned cidx = p->second; if (!m_config.m_expensive_classes && cidx >= get_group_first_index(cnstr_group::ClassInstance)) m_pattern = true; // use only higher-order (pattern) matching after we start processing class-instance constraints constraint c = p->first; // std::cout << "process_next: " << c << "\n"; m_cnstrs.erase_min(); if (is_choice_cnstr(c)) { return process_choice_constraint(c); } else { auto r = instantiate_metavars(c); c = r.first; bool modified = r.second; if (is_level_eq_cnstr(c)) { if (modified) { return process_constraint(c); } status st = process_l_eq_max(c); if (st != Continue) return st == Solved; st = process_succ_eq_max(c); if (st != Continue) return st == Solved; if (m_config.m_discard) { // we only try try_level_eq_zero and try_merge_max when we are discarding // constraints that canno be solved. st = try_level_eq_zero(c); if (st != Continue) return st == Solved; if (cidx < get_group_first_index(cnstr_group::FlexFlex)) { add_cnstr(c, cnstr_group::FlexFlex); return true; } st = try_merge_max(c); if (st != Continue) return st == Solved; return process_plugin_constraint(c); } else { discard(c); return true; } } else { lean_assert(is_eq_cnstr(c)); if (is_delta_cnstr(c)) { return process_delta(c); } else if (modified) { return is_def_eq(cnstr_lhs_expr(c), cnstr_rhs_expr(c), c.get_justification(), relax_main_opaque(c)); } else if (auto d = is_owned(c)) { // Metavariable in the constraint is owned by choice constraint. // choice constraint was postponed... since c was not modifed // So, we should postpone this one too. add_cnstr(c, to_cnstr_group(*d+1)); return true; } else if (is_flex_rigid(c)) { return process_flex_rigid(c); } else if (is_flex_flex(c)) { return process_flex_flex(c); } else { return process_plugin_constraint(c); } } } } /** \brief Return true if unifier may be able to produce more solutions */ bool more_solutions() const { return !in_conflict() || !m_case_splits.empty(); } typedef optional> next_result; next_result failure() { lean_assert(in_conflict()); if (m_config.m_use_exceptions) throw unifier_exception(*m_conflict, m_subst); else return next_result(); } /** \brief Produce the next solution */ next_result next() { if (!more_solutions()) return failure(); if (!m_first && !m_case_splits.empty()) { justification all_assumptions; for (auto const & cs : m_case_splits) all_assumptions = mk_composite1(all_assumptions, mk_assumption_justification(cs->m_assumption_idx)); set_conflict(all_assumptions); if (!resolve_conflict()) return failure(); } else if (m_first) { m_first = false; } else { // This is not the first run, and there are no case-splits. // We don't throw an exception since there are no more solutions. return next_result(); } while (true) { if (!in_conflict()) { if (m_cnstrs.empty()) break; process_next(); } if (in_conflict() && !resolve_conflict()) return failure(); } lean_assert(!in_conflict()); lean_assert(m_cnstrs.empty()); substitution s = m_subst; s.forget_justifications(); return next_result(mk_pair(s, m_postponed)); } }; unify_result_seq unify(std::shared_ptr u) { if (!u->more_solutions()) { u->failure(); // make sure exception is thrown if u->m_use_exception is true return unify_result_seq(); } else { return mk_lazy_list>([=]() { auto s = u->next(); if (s) return some(mk_pair(*s, unify(u))); else return unify_result_seq::maybe_pair(); }); } } unify_result_seq unify(environment const & env, unsigned num_cs, constraint const * cs, name_generator const & ngen, substitution const & s, unifier_config const & cfg) { return unify(std::make_shared(env, num_cs, cs, ngen, s, cfg)); } unify_result_seq unify(environment const & env, expr const & lhs, expr const & rhs, name_generator const & ngen, bool relax, substitution const & s, unifier_config const & cfg) { substitution new_s = s; expr _lhs = new_s.instantiate(lhs); expr _rhs = new_s.instantiate(rhs); auto u = std::make_shared(env, 0, nullptr, ngen, new_s, cfg); constraint_seq cs; if (!u->m_tc[relax]->is_def_eq(_lhs, _rhs, justification(), cs) || !u->process_constraints(cs)) { return unify_result_seq(); } else { return unify(u); } } static int unify_simple(lua_State * L) { int nargs = lua_gettop(L); unify_status r; if (nargs == 2) r = unify_simple(to_substitution(L, 1), to_constraint(L, 2)); else if (nargs == 3 && is_expr(L, 2)) r = unify_simple(to_substitution(L, 1), to_expr(L, 2), to_expr(L, 3), justification()); else if (nargs == 3 && is_level(L, 2)) r = unify_simple(to_substitution(L, 1), to_level(L, 2), to_level(L, 3), justification()); else if (is_expr(L, 2)) r = unify_simple(to_substitution(L, 1), to_expr(L, 2), to_expr(L, 3), to_justification(L, 4)); else r = unify_simple(to_substitution(L, 1), to_level(L, 2), to_level(L, 3), to_justification(L, 4)); return push_integer(L, static_cast(r)); } DECL_UDATA(unify_result_seq) static const struct luaL_Reg unify_result_seq_m[] = { {"__gc", unify_result_seq_gc}, {0, 0} }; static int unify_result_seq_next(lua_State * L) { unify_result_seq seq = to_unify_result_seq(L, lua_upvalueindex(1)); unify_result_seq::maybe_pair p; p = seq.pull(); if (p) { push_unify_result_seq(L, p->second); lua_replace(L, lua_upvalueindex(1)); push_substitution(L, p->first.first); // TODO(Leo): return postponed constraints } else { lua_pushnil(L); } return 1; } static int push_unify_result_seq_it(lua_State * L, unify_result_seq const & seq) { push_unify_result_seq(L, seq); lua_pushcclosure(L, &safe_function, 1); // create closure with 1 upvalue return 1; } static void to_constraint_buffer(lua_State * L, int idx, buffer & cs) { luaL_checktype(L, idx, LUA_TTABLE); lua_pushvalue(L, idx); // put table on top of the stack int n = objlen(L, idx); for (int i = 1; i <= n; i++) { lua_rawgeti(L, -1, i); cs.push_back(to_constraint(L, -1)); lua_pop(L, 1); } lua_pop(L, 1); } #if 0 static constraints to_constraints(lua_State * L, int idx) { buffer cs; to_constraint_buffer(L, idx, cs); return to_list(cs.begin(), cs.end()); } static unifier_plugin to_unifier_plugin(lua_State * L, int idx) { luaL_checktype(L, idx, LUA_TFUNCTION); // user-fun luaref f(L, idx); return unifier_plugin([=](constraint const & c, name_generator const & ngen) { lua_State * L = f.get_state(); f.push(); push_constraint(L, c); push_name_generator(L, ngen); pcall(L, 2, 1, 0); lazy_list r; if (is_constraint(L, -1)) { // single constraint r = lazy_list(constraints(to_constraint(L, -1))); } else if (lua_istable(L, -1)) { int num = objlen(L, -1); if (num == 0) { // empty table r = lazy_list(); } else { lua_rawgeti(L, -1, 1); if (is_constraint(L, -1)) { // array of constraints case lua_pop(L, 1); r = lazy_list(to_constraints(L, -1)); } else { lua_pop(L, 1); buffer css; // array of array of constraints for (int i = 1; i <= num; i++) { lua_rawgeti(L, -1, i); css.push_back(to_constraints(L, -1)); lua_pop(L, 1); } r = to_lazy(to_list(css.begin(), css.end())); } } } else if (lua_isnil(L, -1)) { // nil case r = lazy_list(); } else { throw exception("invalid unifier plugin, the result value must be a constrant, " "nil, an array of constraints, or an array of arrays of constraints"); } lua_pop(L, 1); return r; }); } #endif static name * g_tmp_prefix = nullptr; static int unify(lua_State * L) { int nargs = lua_gettop(L); unify_result_seq r; environment const & env = to_environment(L, 1); if (is_expr(L, 2)) { if (nargs == 7) r = unify(env, to_expr(L, 2), to_expr(L, 3), to_name_generator(L, 4), lua_toboolean(L, 5), to_substitution(L, 6), unifier_config(to_options(L, 7))); else if (nargs == 6) r = unify(env, to_expr(L, 2), to_expr(L, 3), to_name_generator(L, 4), lua_toboolean(L, 5), to_substitution(L, 6)); else r = unify(env, to_expr(L, 2), to_expr(L, 3), to_name_generator(L, 4), lua_toboolean(L, 5)); } else { buffer cs; to_constraint_buffer(L, 2, cs); if (nargs == 5) r = unify(env, cs.size(), cs.data(), to_name_generator(L, 3), to_substitution(L, 4), unifier_config(to_options(L, 5))); else if (nargs == 4) r = unify(env, cs.size(), cs.data(), to_name_generator(L, 3), to_substitution(L, 4)); else r = unify(env, cs.size(), cs.data(), to_name_generator(L, 3)); } return push_unify_result_seq_it(L, r); } void open_unifier(lua_State * L) { luaL_newmetatable(L, unify_result_seq_mt); lua_pushvalue(L, -1); lua_setfield(L, -2, "__index"); setfuncs(L, unify_result_seq_m, 0); SET_GLOBAL_FUN(unify_result_seq_pred, "is_unify_result_seq"); SET_GLOBAL_FUN(unify_simple, "unify_simple"); SET_GLOBAL_FUN(unify, "unify"); lua_newtable(L); SET_ENUM("Solved", unify_status::Solved); SET_ENUM("Failed", unify_status::Failed); SET_ENUM("Unsupported", unify_status::Unsupported); lua_setglobal(L, "unify_status"); } void initialize_unifier() { g_unifier_max_steps = new name{"unifier", "max_steps"}; g_unifier_computation = new name{"unifier", "computation"}; g_unifier_expensive_classes = new name{"unifier", "expensive_classes"}; register_unsigned_option(*g_unifier_max_steps, LEAN_DEFAULT_UNIFIER_MAX_STEPS, "(unifier) maximum number of steps"); register_bool_option(*g_unifier_computation, LEAN_DEFAULT_UNIFIER_COMPUTATION, "(unifier) always case-split on reduction/computational steps when solving flex-rigid and delta-delta constraints"); register_bool_option(*g_unifier_expensive_classes, LEAN_DEFAULT_UNIFIER_EXPENSIVE_CLASSES, "(unifier) use \"full\" higher-order unification when solving class instances"); g_dont_care_cnstr = new constraint(mk_eq_cnstr(expr(), expr(), justification(), false)); g_tmp_prefix = new name(name::mk_internal_unique_name()); } void finalize_unifier() { delete g_tmp_prefix; delete g_dont_care_cnstr; delete g_unifier_max_steps; delete g_unifier_computation; delete g_unifier_expensive_classes; } }