/* Copyright (c) 2013 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 #include "util/safe_arith.h" #include "kernel/for_each.h" #include "kernel/kernel_exception.h" #include "kernel/environment.h" #include "kernel/type_checker.h" #include "kernel/normalizer.h" namespace lean { class extension_factory { std::vector m_makers; std::mutex m_makers_mutex; public: unsigned register_extension(environment::mk_extension mk) { std::lock_guard lock(m_makers_mutex); unsigned r = m_makers.size(); m_makers.push_back(mk); return r; } std::unique_ptr mk(unsigned extid) { std::lock_guard lock(m_makers_mutex); return m_makers[extid](); } }; static std::unique_ptr g_extension_factory; static extension_factory & get_extension_factory() { if (!g_extension_factory) g_extension_factory.reset(new extension_factory()); return *g_extension_factory; } unsigned environment::register_extension(mk_extension mk) { return get_extension_factory().register_extension(mk); } /** \brief Implementation of the Lean environment. */ struct environment::imp { // Remark: only named objects are stored in the dictionary. typedef std::unordered_map object_dictionary; typedef std::tuple constraint; // Universe variable management std::vector m_constraints; std::vector m_uvars; // Children environment management #ifdef LEAN_THREAD_UNSAFE unsigned m_num_children; #else std::atomic m_num_children; #endif std::shared_ptr m_parent; // Object management std::vector m_objects; object_dictionary m_object_dictionary; std::unique_ptr m_type_checker; std::vector> m_extensions; friend class extension; extension & get_extension_core(unsigned extid) { if (extid >= m_extensions.size()) m_extensions.resize(extid+1); if (!m_extensions[extid]) { std::unique_ptr ext = get_extension_factory().mk(extid); ext->m_extid = extid; ext->m_env = this; m_extensions[extid].swap(ext); } return *(m_extensions[extid].get()); } unsigned get_max_weight(expr const & e) { unsigned w = 0; auto proc = [&](expr const & c, unsigned) { if (is_constant(c)) { object const & obj = get_object_core(const_name(c)); if (obj) w = std::max(w, obj.get_weight()); } return true; }; for_each_fn visitor(proc); visitor(e); return w; } /** \brief Return true iff this environment has children. \remark If an environment has children than it cannot be updated. That is, it is read-only. */ bool has_children() const { return m_num_children > 0; } void inc_children() { m_num_children++; } void dec_children() { m_num_children--; } /** \brief Return true iff this environment has a parent environment */ bool has_parent() const { return m_parent != nullptr; } /** \brief Throw exception if environment or its ancestors already have an object with the given name. */ void check_name_core(name const & n, environment const & env) { if (has_parent()) m_parent->check_name_core(n, env); if (m_object_dictionary.find(n) != m_object_dictionary.end()) throw already_declared_exception(env, n); } void check_name(name const & n, environment const & env) { if (has_children()) throw read_only_environment_exception(env); check_name_core(n, env); } /** \brief Store new named object inside internal data-structures */ void register_named_object(object const & new_obj) { m_objects.push_back(new_obj); m_object_dictionary.insert(std::make_pair(new_obj.get_name(), new_obj)); } /** \brief Return the object named \c n in the environment or its ancestors. Return null object if there is no object with the given name. */ object const & get_object_core(name const & n) const { auto it = m_object_dictionary.find(n); if (it == m_object_dictionary.end()) { if (has_parent()) return m_parent->get_object_core(n); else return object::null(); } else { return it->second; } } object const & get_object(name const & n, environment const & env) const { object const & obj = get_object_core(n); if (obj) return obj; else throw unknown_object_exception(env, n); } /** \brief Return true if u >= v + k is implied by constraints \pre is_uvar(u) && is_uvar(v) */ bool is_implied(level const & u, level const & v, int k) { lean_assert(is_uvar(u) && is_uvar(v)); if (u == v) return k <= 0; else return std::any_of(m_constraints.begin(), m_constraints.end(), [&](constraint const & c) { return std::get<0>(c) == u && std::get<1>(c) == v && std::get<2>(c) >= k; }); } /** \brief Return true iff l1 >= l2 + k by asserted universe constraints. */ bool is_ge(level const & l1, level const & l2, int k) { if (l1 == l2) return k <= 0; switch (kind(l2)) { case level_kind::UVar: switch (kind(l1)) { case level_kind::UVar: return is_implied(l1, l2, k); case level_kind::Lift: return is_ge(lift_of(l1), l2, safe_sub(k, lift_offset(l1))); case level_kind::Max: return std::any_of(max_begin_levels(l1), max_end_levels(l1), [&](level const & l) { return is_ge(l, l2, k); }); } case level_kind::Lift: return is_ge(l1, lift_of(l2), safe_add(k, lift_offset(l2))); case level_kind::Max: return std::all_of(max_begin_levels(l2), max_end_levels(l2), [&](level const & l) { return is_ge(l1, l, k); }); } lean_unreachable(); // LCOV_EXCL_LINE } /** \brief Return true iff l1 >= l2 is implied by asserted universe constraints. */ bool is_ge(level const & l1, level const & l2) { if (has_parent()) return m_parent->is_ge(l1, l2); else return is_ge(l1, l2, 0); } /** \brief Add a new universe variable */ level add_uvar(name const & n, environment const & env) { check_name(n, env); level r(n); m_uvars.push_back(r); return r; } /** \brief Add basic constraint u >= v + d, and all basic constraints implied by transitivity. \pre is_uvar(u) && is_uvar(v) */ void add_constraint(level const & u, level const & v, int d) { lean_assert(is_uvar(u) && is_uvar(v)); if (is_implied(u, v, d)) return; // redundant buffer to_add; for (constraint const & c : m_constraints) { if (std::get<0>(c) == v) { level const & l3 = std::get<1>(c); int u_l3_d = safe_add(d, std::get<2>(c)); if (!is_implied(u, l3, u_l3_d)) to_add.emplace_back(u, l3, u_l3_d); } } m_constraints.emplace_back(u, v, d); for (constraint const & c : to_add) { m_constraints.push_back(c); } } /** \brief Add all basic constraints implied by n >= l + k A basic constraint is a constraint of the form u >= v + k where u and v are universe variables. */ void add_constraints(level const & n, level const & l, int k) { lean_assert(is_uvar(n)); switch (kind(l)) { case level_kind::UVar: add_constraint(n, l, k); return; case level_kind::Lift: add_constraints(n, lift_of(l), safe_add(k, lift_offset(l))); return; case level_kind::Max: std::for_each(max_begin_levels(l), max_end_levels(l), [&](level const & l1) { add_constraints(n, l1, k); }); return; } lean_unreachable(); // LCOV_EXCL_LINE } /** \brief Add a new universe variable with constraint n >= l */ level add_uvar(name const & n, level const & l, environment const & env) { if (has_parent()) throw kernel_exception(env, "invalid universe declaration, universe variables can only be declared in top-level environments"); if (has_children()) throw read_only_environment_exception(env); level r = add_uvar(n, env); add_constraints(r, l, 0); register_named_object(mk_uvar_decl(n, l)); return r; } /** \brief Return the universe variable with given name. Throw an exception if the environment and its ancestors do not contain a universe variable named \c n. */ level get_uvar(name const & n, environment const & env) const { if (has_parent()) { return m_parent->get_uvar(n, env); } else { auto it = std::find_if(m_uvars.begin(), m_uvars.end(), [&](level const & l) { return uvar_name(l) == n; }); if (it == m_uvars.end()) throw unknown_universe_variable_exception(env, n); else return *it; } } /** \brief Initialize the set of universe variables with bottom */ void init_uvars() { m_uvars.emplace_back(); } /** \brief Throw an exception if \c t is not a type or type of \c v is not convertible to \c t. \remark env is the smart pointer of imp. We need it because infer_universe and infer_type expect an environment instead of environment::imp. */ void check_type(name const & n, expr const & t, expr const & v, environment const & env) { m_type_checker->check_type(t); expr v_t = m_type_checker->infer_type(v); if (!m_type_checker->is_convertible(v_t, t)) throw def_type_mismatch_exception(env, n, t, v, v_t); } /** \brief Throw exception if it is not a valid new definition */ void check_new_definition(name const & n, expr const & t, expr const & v, environment const & env) { check_name(n, env); check_type(n, t, v, env); } /** \brief Add a new builtin value to this environment */ void add_builtin(expr const & v, environment const & env) { if (!is_value(v)) throw invalid_builtin_value_declaration(env, v); name const & n = to_value(v).get_name(); check_name(n, env); name const & u = to_value(v).get_unicode_name(); check_name(u, env); register_named_object(mk_builtin(v)); if (u != n) { add_definition(u, to_value(v).get_type(), mk_constant(n), false, env); } } /** \brief Add a new builtin value set to this environment */ void add_builtin_set(expr const & r, environment const & env) { if (!is_value(r)) throw invalid_builtin_value_declaration(env, r); check_name(to_value(r).get_name(), env); register_named_object(mk_builtin_set(r)); } /** \brief Add new definition. */ void add_definition(name const & n, expr const & t, expr const & v, bool opaque, environment const & env) { check_new_definition(n, t, v, env); unsigned w = get_max_weight(v) + 1; register_named_object(mk_definition(n, t, v, opaque, w)); } /** \brief Add new definition. The type of the new definition is the type of \c v. */ void add_definition(name const & n, expr const & v, bool opaque, environment const & env) { check_name(n, env); expr v_t = m_type_checker->infer_type(v); unsigned w = get_max_weight(v) + 1; register_named_object(mk_definition(n, v_t, v, opaque, w)); } /** \brief Add new theorem. */ void add_theorem(name const & n, expr const & t, expr const & v, environment const & env) { check_new_definition(n, t, v, env); register_named_object(mk_theorem(n, t, v)); } /** \brief Add new axiom. */ void add_axiom(name const & n, expr const & t, environment const & env) { check_name(n, env); m_type_checker->check_type(t); register_named_object(mk_axiom(n, t)); } /** \brief Add new variable. */ void add_var(name const & n, expr const & t, environment const & env) { check_name(n, env); m_type_checker->check_type(t); register_named_object(mk_var_decl(n, t)); } unsigned get_num_objects(bool local) const { if (local || !has_parent()) { return m_objects.size(); } else { return m_objects.size() + m_parent->get_num_objects(false); } } object const & get_object(unsigned i, bool local) const { if (local || !has_parent()) { return m_objects[i]; } else { unsigned num_parent_objects = m_parent->get_num_objects(false); if (i >= num_parent_objects) return m_objects[i - num_parent_objects]; else return m_parent->get_object(i, false); } } expr infer_type(expr const & e, context const & ctx) { return m_type_checker->infer_type(e, ctx); } expr normalize(expr const & e, context const & ctx) { return m_type_checker->get_normalizer()(e, ctx); } /** \brief Display universal variable constraints and objects stored in this environment and its parents. */ void display(std::ostream & out, environment const & env) const { if (has_parent()) m_parent->display(out, env); for (object const & obj : m_objects) { if (obj.has_name()) { out << obj.keyword() << " " << obj.get_name() << "\n"; } } } void set_interrupt(bool flag) { m_type_checker->set_interrupt(flag); } imp(): m_num_children(0) { init_uvars(); } imp(std::shared_ptr const & parent): m_num_children(0), m_parent(parent) { m_parent->inc_children(); } ~imp() { if (m_parent) m_parent->dec_children(); } }; environment::environment(): m_ptr(new imp()) { m_ptr->m_type_checker.reset(new type_checker(*this)); } // used when creating a new child environment environment::environment(std::shared_ptr const & parent, bool): m_ptr(new imp(parent)) { m_ptr->m_type_checker.reset(new type_checker(*this)); } // used when creating a reference to the parent environment environment::environment(std::shared_ptr const & ptr): m_ptr(ptr) { } environment::~environment() { } environment environment::mk_child() const { return environment(m_ptr, true); } bool environment::has_children() const { return m_ptr->has_children(); } bool environment::has_parent() const { return m_ptr->has_parent(); } environment environment::parent() const { lean_assert(has_parent()); return environment(m_ptr->m_parent); } level environment::add_uvar(name const & n, level const & l) { return m_ptr->add_uvar(n, l, *this); } bool environment::is_ge(level const & l1, level const & l2) const { return m_ptr->is_ge(l1, l2); } level environment::get_uvar(name const & n) const { return m_ptr->get_uvar(n, *this); } void environment::add_builtin(expr const & v) { return m_ptr->add_builtin(v, *this); } void environment::add_builtin_set(expr const & r) { return m_ptr->add_builtin_set(r, *this); } void environment::add_definition(name const & n, expr const & t, expr const & v, bool opaque) { m_ptr->add_definition(n, t, v, opaque, *this); } void environment::add_theorem(name const & n, expr const & t, expr const & v) { m_ptr->add_theorem(n, t, v, *this); } void environment::add_definition(name const & n, expr const & v, bool opaque) { m_ptr->add_definition(n, v, opaque, *this); } void environment::add_axiom(name const & n, expr const & t) { m_ptr->add_axiom(n, t, *this); } void environment::add_var(name const & n, expr const & t) { m_ptr->add_var(n, t, *this); } void environment::add_neutral_object(neutral_object_cell * o) { m_ptr->m_objects.push_back(mk_neutral(o)); } object const & environment::get_object(name const & n) const { return m_ptr->get_object(n, *this); } object const & environment::find_object(name const & n) const { return m_ptr->get_object_core(n); } unsigned environment::get_num_objects(bool local) const { return m_ptr->get_num_objects(local); } object const & environment::get_object(unsigned i, bool local) const { return m_ptr->get_object(i, local); } expr environment::infer_type(expr const & e, context const & ctx) { return m_ptr->infer_type(e, ctx); } expr environment::normalize(expr const & e, context const & ctx) { return m_ptr->normalize(e, ctx); } void environment::display(std::ostream & out) const { m_ptr->display(out, *this); } void environment::set_interrupt(bool flag) { m_ptr->set_interrupt(flag); } environment::extension const & environment::get_extension_core(unsigned extid) const { return m_ptr->get_extension_core(extid); } environment::extension & environment::get_extension_core(unsigned extid) { return m_ptr->get_extension_core(extid); } environment::extension::extension(): m_env(nullptr), m_extid(0) { } environment::extension::~extension() { } environment::extension const * environment::extension::get_parent_core() const { if (m_env == nullptr) return nullptr; imp * parent = m_env->m_parent.get(); while (parent) { if (m_extid < parent->m_extensions.size()) { extension * ext = parent->m_extensions[m_extid].get(); if (ext) return ext; } parent = parent->m_parent.get(); } return nullptr; } }