vm_obj nat_add(vm_obj const & a1, vm_obj const & a2) {
if (is_simple(a1) && is_simple(a2)) {
return mk_vm_nat(cidx(a1) + cidx(a2));
} else {
return mk_vm_mpz(to_mpz1(a1) + to_mpz2(a2));
}
}
vm_obj tactic_get_spec_prefix_size(vm_obj const & fn, vm_obj const & n, vm_obj const & m, vm_obj const & s) {
TRY;
type_context ctx = mk_type_context_for(s, m);
return tactic::mk_success(mk_vm_nat(get_specialization_prefix_size(ctx, to_expr(fn), force_to_unsigned(n, 0))),
tactic::to_state(s));
CATCH;
}
vm_obj nat_succ(vm_obj const & a) {
if (is_simple(a)) {
return mk_vm_nat(cidx(a) + 1);
} else {
return mk_vm_mpz(to_mpz1(a) + 1);
}
}
vm_obj array_foreach(vm_obj const &, vm_obj const & n, vm_obj const & a, vm_obj const & fn) {
/* TODO(Leo): handle case where n is too big */
unsigned _n = force_to_unsigned(n);
parray<vm_obj> const & p = to_array(a);
if (a.raw()->get_rc() == 1) {
parray<vm_obj> & _p = const_cast<parray<vm_obj> &>(p);
for (unsigned i = 0; i < _n; i++)
_p.set(i, invoke(fn, mk_vm_nat(i), _p[i]));
return a;
} else {
parray<vm_obj> new_a;
for (unsigned i = 0; i < _n; i++) {
new_a.push_back(invoke(fn, mk_vm_nat(i), p[i]));
}
return to_obj(new_a);
}
}
vm_obj nat_mod(vm_obj const & a1, vm_obj const & a2) {
if (is_simple(a1) && is_simple(a2)) {
unsigned v1 = cidx(a1);
unsigned v2 = cidx(a2);
if (v2 == 0)
return a1;
else
return mk_vm_nat(v1 % v2);
} else {
mpz const & v1 = to_mpz1(a1);
mpz const & v2 = to_mpz2(a2);
if (v2 == 0)
return a1;
else
return mk_vm_nat(v1 % v2);
}
}
vm_obj nat_sub(vm_obj const & a1, vm_obj const & a2) {
if (is_simple(a1) && is_simple(a2)) {
unsigned v1 = cidx(a1);
unsigned v2 = cidx(a2);
if (v2 > v1)
return mk_vm_simple(0);
else
return mk_vm_nat(v1 - v2);
} else {
mpz const & v1 = to_mpz1(a1);
mpz const & v2 = to_mpz2(a2);
if (v2 > v1)
return mk_vm_simple(0);
else
return mk_vm_nat(v1 - v2);
}
}
vm_obj array_mk(vm_obj const &, vm_obj const & n, vm_obj const & fn) {
/* TODO(Leo): handle case where n is too big */
unsigned _n = force_to_unsigned(n);
parray<vm_obj> a;
for (unsigned i = 0; i < _n; ++i) {
a.push_back(invoke(fn, mk_vm_nat(i)));
}
return to_obj(a);
}
vm_obj attribute_fingerprint(vm_obj const & vm_n, vm_obj const & vm_s) {
auto const & s = to_tactic_state(vm_s);
auto const & n = to_name(vm_n);
unsigned h;
LEAN_TACTIC_TRY;
h = get_attribute(s.env(), n).get_fingerprint(s.env());
LEAN_TACTIC_CATCH(s);
return mk_tactic_success(mk_vm_nat(h), s);
}
vm_obj array_iterate(vm_obj const &, vm_obj const &, vm_obj const & n,
vm_obj const & a, vm_obj const & b, vm_obj const & fn) {
/* TODO(Leo): handle case where n is too big */
unsigned _n = force_to_unsigned(n);
parray<vm_obj> const & p = to_array(a);
vm_obj r = b;
for (unsigned i = 0; i < _n; i++)
r = invoke(fn, mk_vm_nat(i), p[i], r);
return r;
}
vm_obj revert(list<expr> const & ls, tactic_state const & s) {
optional<metavar_decl> g = s.get_main_goal_decl();
if (!g) return mk_no_goals_exception(s);
local_context lctx = g->get_context();
buffer<expr> locals;
for (expr const & l : ls) {
if (lctx.get_local_decl(l)) {
locals.push_back(l);
} else {
return mk_tactic_exception(sstream() << "revert tactic failed, unknown '"
<< local_pp_name(l) << "' hypothesis", s);
}
}
tactic_state new_s = revert(locals, s);
return mk_tactic_success(mk_vm_nat(locals.size()), new_s);
}
vm_obj nat_repeat(vm_obj const &, vm_obj const & f, vm_obj const & n, vm_obj const & a) {
if (is_simple(n)) {
unsigned _n = cidx(n);
vm_obj r = a;
for (unsigned i = 0; i < _n ; i++) {
r = invoke(f, mk_vm_simple(i), r);
}
return r;
} else {
mpz _n = to_mpz(n);
mpz i(0);
vm_obj r = a;
while (i < _n) {
r = invoke(f, mk_vm_nat(i), r);
i++;
}
return r;
}
}
vm_obj options_size(vm_obj const & o) {
return mk_vm_nat(to_options(o).size());
}
vm_obj rb_map_size(vm_obj const &, vm_obj const &, vm_obj const & m) {
return mk_vm_nat(to_map(m).size());
}
vm_obj nat_gcd(vm_obj const & a1, vm_obj const & a2) {
mpz r;
gcd(r, to_mpz1(a1), to_mpz2(a2));
return mk_vm_nat(r);
}
vm_obj options_get_nat(vm_obj const & o, vm_obj const & n, vm_obj const & v) {
return mk_vm_nat(to_options(o).get_unsigned(to_name(n), to_unsigned(v)));
}
/* TODO(jroesch): unify with IO */
static vm_obj mk_buffer(parray<vm_obj> const & a) {
return mk_vm_pair(mk_vm_nat(a.size()), to_obj(a));
}
vm_obj to_obj(list<unsigned> const & ls) {
return to_vm_list(ls, [&](unsigned n) { return mk_vm_nat(n); });
}
