feat(library/class): allow any constant to be marked as a class

closes #679
This commit is contained in:
Leonardo de Moura 2015-06-17 16:21:38 -07:00
parent 9e6e406f73
commit ce8f2a1674
7 changed files with 66 additions and 21 deletions

View file

@ -114,8 +114,6 @@ void decl_attributes::parse(buffer<name> const & ns, parser & p) {
m_is_quasireducible = true;
p.next();
} else if (p.curr_is_token(get_class_tk())) {
if (m_def_only)
throw parser_error("invalid '[class]' attribute, definitions cannot be marked as classes", pos);
m_is_class = true;
p.next();
} else if (p.curr_is_token(get_multiple_instances_tk())) {

View file

@ -151,9 +151,7 @@ template class scoped_ext<class_config>;
typedef scoped_ext<class_config> class_ext;
static void check_class(environment const & env, name const & c_name) {
declaration c_d = env.get(c_name);
if (c_d.is_definition())
throw exception(sstream() << "invalid class, '" << c_name << "' is a definition");
env.get(c_name);
}
static void check_is_class(environment const & env, name const & c_name) {
@ -182,12 +180,25 @@ void get_classes(environment const & env, buffer<name> & classes) {
});
}
bool is_class(environment const & env, name const & c) {
class_state const & s = class_ext::get_state(env);
return s.m_instances.contains(c);
}
type_checker_ptr mk_class_type_checker(environment const & env, name_generator && ngen, bool conservative) {
auto pred = conservative ? mk_not_reducible_pred(env) : mk_irreducible_pred(env);
class_state s = class_ext::get_state(env);
return mk_type_checker(env, std::move(ngen), [=](name const & n) {
return s.m_instances.contains(n) || pred(n);
});
}
static name * g_tmp_prefix = nullptr;
environment add_instance(environment const & env, name const & n, unsigned priority, bool persistent) {
declaration d = env.get(n);
expr type = d.get_type();
name_generator ngen(*g_tmp_prefix);
auto tc = mk_type_checker(env, ngen.mk_child());
auto tc = mk_class_type_checker(env, ngen.mk_child(), false);
while (true) {
type = tc->whnf(type).first;
if (!is_pi(type))
@ -213,11 +224,6 @@ bool try_multiple_instances(environment const & env, name const & n) {
return s.try_multiple_instances(n);
}
bool is_class(environment const & env, name const & c) {
class_state const & s = class_ext::get_state(env);
return s.m_instances.contains(c);
}
bool is_instance(environment const & env, name const & i) {
class_state const & s = class_ext::get_state(env);
return s.is_instance(i);
@ -229,7 +235,7 @@ list<name> get_class_instances(environment const & env, name const & c) {
}
/** \brief If the constant \c e is a class, return its name */
optional<name> constant_is_ext_class(environment const & env, expr const & e) {
static optional<name> constant_is_ext_class(environment const & env, expr const & e) {
name const & cls_name = const_name(e);
if (is_class(env, cls_name)) {
return optional<name>(cls_name);
@ -243,7 +249,7 @@ optional<name> constant_is_ext_class(environment const & env, expr const & e) {
l_false: \c type is not a class.
l_undef: procedure did not establish whether \c type is a class or not.
*/
lbool is_quick_ext_class(type_checker const & tc, expr const & type, name & result) {
static lbool is_quick_ext_class(type_checker const & tc, expr const & type, name & result) {
environment const & env = tc.env();
expr const * it = &type;
while (true) {
@ -287,7 +293,7 @@ lbool is_quick_ext_class(type_checker const & tc, expr const & type, name & resu
}
/** \brief Full/Expensive test for \c is_ext_class */
optional<name> is_full_ext_class(type_checker & tc, expr type) {
static optional<name> is_full_ext_class(type_checker & tc, expr type) {
type = tc.whnf(type).first;
if (is_pi(type)) {
return is_full_ext_class(tc, instantiate(binding_body(type), mk_local(tc.mk_fresh_name(), binding_domain(type))));

View file

@ -5,8 +5,10 @@ Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
*/
#pragma once
#include "library/util.h"
namespace lean {
/** \brief Create type checker that treats classes as opaque constants */
type_checker_ptr mk_class_type_checker(environment const & env, name_generator && ngen, bool conservative);
/** \brief Add a new 'class' to the environment (if it is not already declared) */
environment add_class(environment const & env, name const & n, bool persistent = true);
/** \brief Add a new 'class instance' to the environment with default priority. */

View file

@ -113,10 +113,7 @@ struct class_instance_context {
m_trace_instances = get_class_trace_instances(ios.get_options());
m_max_depth = get_class_instance_max_depth(ios.get_options());
m_conservative = get_class_conservative(ios.get_options());
if (m_conservative)
m_tc = mk_type_checker(env, m_ngen.mk_child(), UnfoldReducible);
else
m_tc = mk_type_checker(env, m_ngen.mk_child());
m_tc = mk_class_type_checker(env, m_ngen.mk_child(), m_conservative);
options opts = m_ios.get_options();
opts = opts.update_if_undef(get_pp_purify_metavars_name(), false);
opts = opts.update_if_undef(get_pp_implicit_name(), true);

View file

@ -1,2 +0,0 @@
bad_class.lean:4:0: error: invalid class, 'foo.subsingleton' is a definition
bad_class.lean:6:0: error: 'eq' is not a class

22
tests/lean/run/679a.lean Normal file
View file

@ -0,0 +1,22 @@
import data.finset
open bool nat list finset
attribute finset [class]
definition fin_nat [instance] : finset nat :=
to_finset [0]
definition fin_bool [instance] : finset bool :=
to_finset [tt, ff]
definition tst (A : Type) [s : finset A] : finset A :=
s
example : tst nat = to_finset [0] :=
rfl
example : tst bool = to_finset [ff, tt] :=
dec_trivial
example : tst bool = to_finset [tt, ff] :=
rfl

22
tests/lean/run/679b.lean Normal file
View file

@ -0,0 +1,22 @@
import data.finset
open bool nat list finset
definition fset [class] (A : Type) := finset A
definition fin_nat [instance] : fset nat :=
to_finset [0]
definition fin_bool [instance] : fset bool :=
to_finset [tt, ff]
definition tst (A : Type) [s : fset A] : finset A :=
s
example : tst nat = to_finset [0] :=
rfl
example : tst bool = to_finset [ff, tt] :=
dec_trivial
example : tst bool = to_finset [tt, ff] :=
rfl