251 lines
9.9 KiB
C++
251 lines
9.9 KiB
C++
|
/*
|
||
|
|
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
|
||
|
|
Released under Apache 2.0 license as described in the file LICENSE.
|
||
|
|
|
||
|
|
Author: Leonardo de Moura
|
||
|
|
*/
|
||
|
|
#include "util/sstream.h"
|
||
|
|
#include "kernel/inductive/inductive.h"
|
||
|
|
#include "library/scoped_ext.h"
|
||
|
|
#include "library/util.h"
|
||
|
|
#include "library/kernel_serializer.h"
|
||
|
|
#include "library/user_recursors.h"
|
||
|
|
|
||
|
|
namespace lean {
|
||
|
|
bool recursor_info::is_minor(unsigned pos) const {
|
||
|
|
if (pos <= get_motive_pos())
|
||
|
|
return false;
|
||
|
|
if (get_first_index_pos() <= pos && pos <= m_major_pos)
|
||
|
|
return false;
|
||
|
|
return true;
|
||
|
|
}
|
||
|
|
|
||
|
|
recursor_info::recursor_info(name const & r, name const & I, unsigned num_params, unsigned num_indices, unsigned major,
|
||
|
|
optional<unsigned> const & motive_univ_pos, bool dep_elim):
|
||
|
|
m_recursor(r), m_type_name(I), m_num_params(num_params), m_num_indices(num_indices), m_major_pos(major),
|
||
|
|
m_motive_univ_pos(motive_univ_pos), m_dep_elim(dep_elim) {}
|
||
|
|
recursor_info::recursor_info() {}
|
||
|
|
|
||
|
|
void recursor_info::write(serializer & s) const {
|
||
|
|
s << m_recursor << m_type_name << m_num_params << m_num_indices << m_major_pos << m_motive_univ_pos << m_dep_elim;
|
||
|
|
}
|
||
|
|
|
||
|
|
recursor_info recursor_info::read(deserializer & d) {
|
||
|
|
recursor_info info;
|
||
|
|
d >> info.m_recursor >> info.m_type_name >> info.m_num_params >> info.m_num_indices >> info.m_major_pos
|
||
|
|
>> info.m_motive_univ_pos >> info.m_dep_elim;
|
||
|
|
return info;
|
||
|
|
}
|
||
|
|
|
||
|
|
static void throw_invalid_motive(expr const & C) {
|
||
|
|
throw exception(sstream() << "invalid user defined recursor, motive '" << C
|
||
|
|
<< "' must have a type of the form (C : Pi (i : B A), I A i -> Type), "
|
||
|
|
"where A is (possibly empty) sequence of bound variables (aka parameters), "
|
||
|
|
"(i : B A) is a (possibly empty) telescope (aka indices), "
|
||
|
|
"and I is a constant");
|
||
|
|
}
|
||
|
|
|
||
|
|
static void throw_invalid_major(buffer<expr> const & tele, expr const & I, unsigned num_params,
|
||
|
|
unsigned num_indices, unsigned major_pos) {
|
||
|
|
sstream msg;
|
||
|
|
msg << "invalid user defined recursor, major premise '" << tele[major_pos] << "' is expected to have type " << I;
|
||
|
|
for (unsigned i = 0; i < num_params; i++)
|
||
|
|
msg << " " << tele[i];
|
||
|
|
for (unsigned i = major_pos - num_indices; i < major_pos; i++)
|
||
|
|
msg << " " << tele[i];
|
||
|
|
throw exception(msg);
|
||
|
|
}
|
||
|
|
|
||
|
|
recursor_info mk_recursor_info(environment const & env, name const & r) {
|
||
|
|
if (auto I = inductive::is_elim_rule(env, r)) {
|
||
|
|
if (*inductive::get_num_type_formers(env, r) > 1)
|
||
|
|
throw exception(sstream() << "unsupported recursor '" << r << "', it has multiple motives");
|
||
|
|
optional<unsigned> motive_univ_pos;
|
||
|
|
if (env.get(name(*I, "rec")).get_num_univ_params() != env.get(name(*I)).get_num_univ_params())
|
||
|
|
motive_univ_pos = 0;
|
||
|
|
return recursor_info(r, *I,
|
||
|
|
*inductive::get_num_params(env, *I),
|
||
|
|
*inductive::get_num_indices(env, *I),
|
||
|
|
*inductive::get_elim_major_idx(env, *I),
|
||
|
|
motive_univ_pos,
|
||
|
|
inductive::has_dep_elim(env, *I));
|
||
|
|
}
|
||
|
|
declaration d = env.get(r);
|
||
|
|
type_checker tc(env);
|
||
|
|
buffer<expr> tele;
|
||
|
|
expr rtype = to_telescope(tc, d.get_type(), tele);
|
||
|
|
buffer<expr> C_args;
|
||
|
|
expr C = get_app_args(rtype, C_args);
|
||
|
|
if (!is_local(C) || !std::all_of(C_args.begin(), C_args.end(), is_local) || C_args.empty()) {
|
||
|
|
throw exception("invalid user defined recursor, result type must be of the form (C i t), "
|
||
|
|
"where C and t are bound variables, and i is a (possibly empty) sequence of bound variables");
|
||
|
|
}
|
||
|
|
unsigned num_indices = C_args.size() - 1;
|
||
|
|
unsigned num_params = 0;
|
||
|
|
for (expr const & x : tele) {
|
||
|
|
if (mlocal_name(x) == mlocal_name(C))
|
||
|
|
break;
|
||
|
|
num_params++;
|
||
|
|
}
|
||
|
|
buffer<expr> C_tele;
|
||
|
|
expr C_rtype = to_telescope(tc, mlocal_type(C), C_tele);
|
||
|
|
if (!is_sort(C_rtype) || C_tele.size() != C_args.size()) {
|
||
|
|
throw_invalid_motive(C);
|
||
|
|
}
|
||
|
|
optional<unsigned> C_univ_pos;
|
||
|
|
level C_lvl = sort_level(C_rtype);
|
||
|
|
if (!is_standard(env) || !is_zero(C_lvl)) {
|
||
|
|
if (!is_param(C_lvl)) {
|
||
|
|
if (is_standard(env))
|
||
|
|
throw exception("invalid user defined recursor, "
|
||
|
|
"motive result sort must be Prop or Type.{l} where l is a universe parameter");
|
||
|
|
else
|
||
|
|
throw exception("invalid user defined recursor, "
|
||
|
|
"motive result sort must be Type.{l} where l is a universe parameter");
|
||
|
|
}
|
||
|
|
name l = param_id(C_lvl);
|
||
|
|
C_univ_pos = 0;
|
||
|
|
for (name const & l_curr : d.get_univ_params()) {
|
||
|
|
if (l_curr == l)
|
||
|
|
break;
|
||
|
|
C_univ_pos = *C_univ_pos + 1;
|
||
|
|
}
|
||
|
|
lean_assert(*C_univ_pos < length(d.get_univ_params()));
|
||
|
|
}
|
||
|
|
|
||
|
|
buffer<expr> I_args;
|
||
|
|
expr I = get_app_args(mlocal_type(C_tele.back()), I_args);
|
||
|
|
if (!is_constant(I) || I_args.size() != num_params + num_indices) {
|
||
|
|
throw_invalid_motive(C);
|
||
|
|
}
|
||
|
|
for (unsigned i = 0; i < num_params; i++) {
|
||
|
|
if (mlocal_name(I_args[i]) != mlocal_name(tele[i]))
|
||
|
|
throw_invalid_motive(C);
|
||
|
|
}
|
||
|
|
for (unsigned i = 0; i < num_indices; i++) {
|
||
|
|
if (mlocal_name(I_args[num_params + i]) != mlocal_name(C_tele[i]))
|
||
|
|
throw_invalid_motive(C);
|
||
|
|
}
|
||
|
|
expr const & major = C_args.back();
|
||
|
|
unsigned major_pos = 0;
|
||
|
|
for (expr const & x : tele) {
|
||
|
|
if (mlocal_name(x) == mlocal_name(major))
|
||
|
|
break;
|
||
|
|
major_pos++;
|
||
|
|
}
|
||
|
|
lean_assert(major_pos < tele.size());
|
||
|
|
if (major_pos < num_indices)
|
||
|
|
throw exception(sstream() << "invalid user defined recursor, indices must occur before major premise '"
|
||
|
|
<< major << "'");
|
||
|
|
recursor_info info(r, const_name(I), num_params, num_indices, major_pos, C_univ_pos, true);
|
||
|
|
unsigned first_index_pos = info.get_first_index_pos();
|
||
|
|
for (unsigned i = 0; i < num_indices; i++) {
|
||
|
|
if (mlocal_name(tele[first_index_pos+i]) != mlocal_name(C_args[i])) {
|
||
|
|
throw exception(sstream() << "invalid user defined recursor, index '" << C_args[i]
|
||
|
|
<< "' expected, but got '" << tele[i] << "'");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
buffer<expr> I_args_major;
|
||
|
|
expr I_major = get_app_args(mlocal_type(tele[major_pos]), I_args_major);
|
||
|
|
if (I != I_major)
|
||
|
|
throw_invalid_major(tele, I, num_params, num_indices, major_pos);
|
||
|
|
for (unsigned i = 0; i < num_params; i++) {
|
||
|
|
if (mlocal_name(I_args_major[i]) != mlocal_name(tele[i]))
|
||
|
|
throw_invalid_major(tele, I, num_params, num_indices, major_pos);
|
||
|
|
}
|
||
|
|
for (unsigned i = 0; i < num_indices; i++) {
|
||
|
|
if (mlocal_name(I_args_major[num_params + i]) != mlocal_name(tele[first_index_pos + i]))
|
||
|
|
throw_invalid_major(tele, I, num_params, num_indices, major_pos);
|
||
|
|
}
|
||
|
|
for (unsigned i = 0; i < tele.size(); i++) {
|
||
|
|
if (info.is_minor(i)) {
|
||
|
|
buffer<expr> minor_tele;
|
||
|
|
expr minor_rtype = to_telescope(tc, mlocal_type(tele[i]), minor_tele);
|
||
|
|
expr minor_C = get_app_fn(minor_rtype);
|
||
|
|
if (!is_local(minor_C) || mlocal_name(minor_C) != mlocal_name(C))
|
||
|
|
throw exception(sstream() << "invalid user defined recursor, resultant type of minor premise '"
|
||
|
|
<< tele[i] << "' must be of the form (" << C << " ...)");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return info;
|
||
|
|
}
|
||
|
|
|
||
|
|
struct recursor_state {
|
||
|
|
name_map<recursor_info> m_recursors;
|
||
|
|
name_map<list<name>> m_type2recursors;
|
||
|
|
|
||
|
|
void insert(recursor_info const & info) {
|
||
|
|
m_recursors.insert(info.get_name(), info);
|
||
|
|
if (auto l = m_type2recursors.find(info.get_type_name())) {
|
||
|
|
m_type2recursors.insert(info.get_type_name(),
|
||
|
|
cons(info.get_name(),
|
||
|
|
filter(*l, [&](name const & n) { return n != info.get_name(); })));
|
||
|
|
} else {
|
||
|
|
m_type2recursors.insert(info.get_type_name(), to_list(info.get_name()));
|
||
|
|
}
|
||
|
|
}
|
||
|
|
};
|
||
|
|
|
||
|
|
static name * g_class_name = nullptr;
|
||
|
|
static std::string * g_key = nullptr;
|
||
|
|
|
||
|
|
struct recursor_config {
|
||
|
|
typedef recursor_state state;
|
||
|
|
typedef recursor_info entry;
|
||
|
|
|
||
|
|
static void add_entry(environment const &, io_state const &, state & s, entry const & e) {
|
||
|
|
s.insert(e);
|
||
|
|
}
|
||
|
|
static name const & get_class_name() {
|
||
|
|
return *g_class_name;
|
||
|
|
}
|
||
|
|
static std::string const & get_serialization_key() {
|
||
|
|
return *g_key;
|
||
|
|
}
|
||
|
|
static void write_entry(serializer & s, entry const & e) {
|
||
|
|
e.write(s);
|
||
|
|
}
|
||
|
|
static entry read_entry(deserializer & d) {
|
||
|
|
return recursor_info::read(d);
|
||
|
|
}
|
||
|
|
static optional<unsigned> get_fingerprint(entry const & e) {
|
||
|
|
return some(e.get_name().hash());
|
||
|
|
}
|
||
|
|
};
|
||
|
|
|
||
|
|
template class scoped_ext<recursor_config>;
|
||
|
|
typedef scoped_ext<recursor_config> recursor_ext;
|
||
|
|
|
||
|
|
environment add_user_recursor(environment const & env, name const & r, bool persistent) {
|
||
|
|
if (inductive::is_elim_rule(env, r))
|
||
|
|
throw exception(sstream() << "invalid user defined recursor, '" << r << "' is a builtin recursor");
|
||
|
|
recursor_info info = mk_recursor_info(env, r);
|
||
|
|
return recursor_ext::add_entry(env, get_dummy_ios(), info, persistent);
|
||
|
|
}
|
||
|
|
|
||
|
|
recursor_info get_recursor_info(environment const & env, name const & r) {
|
||
|
|
if (auto info = recursor_ext::get_state(env).m_recursors.find(r))
|
||
|
|
return *info;
|
||
|
|
return mk_recursor_info(env, r);
|
||
|
|
}
|
||
|
|
|
||
|
|
list<name> get_recursors_for(environment const & env, name const & I) {
|
||
|
|
if (auto l = recursor_ext::get_state(env).m_type2recursors.find(I))
|
||
|
|
return *l;
|
||
|
|
else
|
||
|
|
return list<name>();
|
||
|
|
}
|
||
|
|
|
||
|
|
void initialize_user_recursors() {
|
||
|
|
g_class_name = new name("recursor");
|
||
|
|
g_key = new std::string("urec");
|
||
|
|
recursor_ext::initialize();
|
||
|
|
}
|
||
|
|
|
||
|
|
void finalize_user_recursors() {
|
||
|
|
recursor_ext::finalize();
|
||
|
|
delete g_class_name;
|
||
|
|
delete g_key;
|
||
|
|
}
|
||
|
|
}
|