vm_obj tactic_to_expr_core(vm_obj const & relaxed, vm_obj const & qe, vm_obj const & _s) {
tactic_state const & s = to_tactic_state(_s);
optional<metavar_decl> g = s.get_main_goal_decl();
if (!g) return mk_no_goals_exception(s);
if (!g_elaborate) {
return mk_tactic_exception("elaborator is not available", s);
}
metavar_context mctx = s.mctx();
try {
environment env = s.env();
expr r = (*g_elaborate)(env, s.get_options(), mctx, g->get_context(), to_expr(qe), to_bool(relaxed));
r = mctx.instantiate_mvars(r);
if (relaxed && has_expr_metavar(r)) {
buffer<expr> new_goals;
name_set found;
for_each(r, [&](expr const & e, unsigned) {
if (!has_expr_metavar(e)) return false;
if (is_metavar_decl_ref(e) && !found.contains(mlocal_name(e))) {
mctx.instantiate_mvars_at_type_of(e);
new_goals.push_back(e);
found.insert(mlocal_name(e));
}
return true;
});
list<expr> new_gs = cons(head(s.goals()), to_list(new_goals.begin(), new_goals.end(), tail(s.goals())));
return mk_tactic_success(to_obj(r), set_env_mctx_goals(s, env, mctx, new_gs));
} else {
return mk_tactic_success(to_obj(r), set_env_mctx(s, env, mctx));
}
} catch (exception & ex) {
return mk_tactic_exception(ex, s);
}
}
unsigned level_cases_on(vm_obj const & o, buffer<vm_obj> & data) {
level const & l = to_level(o);
switch (l.kind()) {
case level_kind::Zero:
break;
case level_kind::Succ:
data.push_back(to_obj(succ_of(l)));
break;
case level_kind::Max:
data.push_back(to_obj(max_lhs(l)));
data.push_back(to_obj(max_rhs(l)));
break;
case level_kind::IMax:
data.push_back(to_obj(imax_lhs(l)));
data.push_back(to_obj(imax_rhs(l)));
break;
case level_kind::Param:
data.push_back(to_obj(param_id(l)));
break;
case level_kind::Global:
data.push_back(to_obj(global_id(l)));
break;
case level_kind::Meta:
data.push_back(to_obj(meta_id(l)));
break;
}
return static_cast<unsigned>(l.kind());
}
vm_obj get_line(vm_obj const &) {
if (get_global_ios().get_options().get_bool("server"))
throw exception("get_line: cannot read from stdin in server mode");
std::string str;
std::getline(std::cin, str);
return to_obj(str);
}
vm_obj options_fold(vm_obj const &, vm_obj const & o, vm_obj const & a, vm_obj const & fn) {
vm_obj r = a;
to_options(o).for_each([&](name const & n) {
r = invoke(fn, to_obj(n), r);
});
return r;
}
vm_obj level_fold(vm_obj const &, vm_obj const & l, vm_obj const & a, vm_obj const & fn) {
vm_obj r = a;
for_each(to_level(l), [&](level const & o) {
r = invoke(fn, to_obj(o), r);
return true;
});
return r;
}
vm_obj nat_to_string(vm_obj const & a) {
std::ostringstream out;
if (is_simple(a)) {
out << cidx(a);
} else {
out << to_mpz(a);
}
return to_obj(out.str());
}
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);
}
unsigned list_cases_on_core(list<A> const & l, buffer<vm_obj> & data) {
if (empty(l)) {
return 0;
} else {
data.push_back(to_obj(head(l)));
data.push_back(list_to_obj(tail(l)));
return 1;
}
}
/* VM builtins */
vm_obj attribute_get_instances(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);
buffer<name> b;
LEAN_TACTIC_TRY;
get_attribute(s.env(), n).get_instances(s.env(), b);
LEAN_TACTIC_CATCH(s);
return mk_tactic_success(to_obj(b), s);
}
vm_obj array_push_back(vm_obj const &, vm_obj const &, vm_obj const & a, vm_obj const & v) {
parray<vm_obj> const & p = to_array(a);
if (a.raw()->get_rc() == 1) {
const_cast<parray<vm_obj> &>(p).push_back(v);
return a;
} else {
parray<vm_obj> new_a = p;
new_a.push_back(v);
return to_obj(new_a);
}
}
// meta_constant level.instantiate : level → list (name × level) → list level
vm_obj level_instantiate(vm_obj const & o, vm_obj const & lst) {
level const & l = to_level(o);
buffer<name> ns;
buffer<level> ls;
vm_obj it = lst;
while (!is_simple(it)) {
vm_obj const & h = cfield(it, 0);
ns.push_back(to_name(cfield(h, 0)));
ls.push_back(to_level(cfield(h, 1)));
it = cfield(it, 1);
}
return to_obj(instantiate(l, to_list(ns), to_list(ls)));
}
/** Implement two different signatures:
1) throwable -> options -> format
2) throwable -> unit -> format */
vm_obj throwable_to_format(vm_obj const & _ex, vm_obj const & _opts) {
throwable * ex = to_throwable(_ex);
if (!ex)
return to_obj(format("null-exception"));
if (auto kex = dynamic_cast<ext_exception*>(ex)) {
if (is_simple(_opts)) {
io_state_stream ios = tout();
formatter fmt = ios.get_formatter();
return to_obj(kex->pp(fmt));
} else {
options opts = to_options(_opts);
scope_trace_env scope1(opts);
io_state_stream ios = tout();
formatter fmt = ios.get_formatter();
return to_obj(kex->pp(fmt));
}
} else if (auto fex = dynamic_cast<formatted_exception*>(ex)) {
return to_obj(fex->pp());
} else {
return to_obj(format(ex->what()));
}
}
vm_obj array_write(vm_obj const &, vm_obj const &, vm_obj const & a, vm_obj const & i, vm_obj const & v) {
/* TODO(Leo): handle case where n is too big */
unsigned idx = force_to_unsigned(i);
parray<vm_obj> const & p = to_array(a);
lean_vm_check(idx < p.size());
if (a.raw()->get_rc() == 1) {
const_cast<parray<vm_obj> &>(p).set(idx, v);
return a;
} else {
parray<vm_obj> new_a = p;
new_a.set(idx, v);
return to_obj(new_a);
}
}
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);
}
}
/**
* @brief Release MD from NI.
*
* If this is the last reference to the MD destroy the object.
*
* @param md_handle the handle of the MD to release
*
* @return PTL_OK Indicates success.
* @return PTL_NO_INIT Indicates that the portals API has not been
* successfully initialized.
* @return PTL_ARG_INVALID Indicates that an invalid argument was
* passed. The definition of which arguments are checked is
* implementation dependent.
* @return PTL_IN_USE Indicates that md_handle has pending operations
* and cannot be released.
*/
int _PtlMDRelease(PPEGBL ptl_handle_md_t md_handle)
{
int err;
md_t *md;
#ifndef NO_ARG_VALIDATION
err = gbl_get();
if (err)
goto err0;
md = to_md(MYGBL_ md_handle);
if (!md) {
err = PTL_ARG_INVALID;
goto err1;
}
#else
md = to_obj(MYGBL_ POOL_ANY, md_handle);
#endif
/* Ensure there is no in-flight transfer. */
if (ref_cnt(&md->obj.obj_ref) > 2) {
err = PTL_ARG_INVALID;
} else {
err = PTL_OK;
md_put(md);
}
md_put(md);
#ifndef NO_ARG_VALIDATION
err1:
gbl_put();
err0:
#endif
return err;
}
vm_obj to_obj(list<ss_param_info> const & ls) {
return to_vm_list(ls, [&](ss_param_info const & p) { return to_obj(p); });
}
/*
structure fun_info :=
(params : list param_info)
(result_deps : list nat) -- parameters the result type depends on
*/
vm_obj to_obj(fun_info const & info) {
return mk_vm_constructor(0, to_obj(info.get_params_info()), to_obj(info.get_result_deps()));
}
/*
structure param_info :=
(is_implicit : bool)
(is_inst_implicit : bool)
(is_prop : bool)
(has_fwd_deps : bool)
(back_deps : list nat) -- previous parameters it depends on
*/
vm_obj to_obj(param_info const & info) {
vm_obj args[5] = { bb(info.is_implicit()), bb(info.is_inst_implicit()),
bb(info.is_prop()), bb(info.has_fwd_deps()),
to_obj(info.get_back_deps()) };
return mk_vm_constructor(0, 5, args);
}
vm_obj rb_map_erase(vm_obj const &, vm_obj const &, vm_obj const & m, vm_obj const & k) {
return to_obj(erase(to_map(m), k));
}
vm_obj rb_map_insert(vm_obj const &, vm_obj const &, vm_obj const & m, vm_obj const & k, vm_obj const & d) {
return to_obj(insert(to_map(m), k, d));
}
vm_obj rb_map_mk_core(vm_obj const &, vm_obj const &, vm_obj const & cmp) {
return to_obj(vm_obj_map(vm_obj_cmp(cmp)));
}
vm_obj level_meta(vm_obj const & n) {
return to_obj(mk_meta_univ(to_name(n)));
}
vm_obj level_succ(vm_obj const & o) {
return to_obj(mk_succ(to_level(o)));
}
vm_obj mk_array(vm_obj const &, vm_obj const & n, vm_obj const & v) {
/* TODO(Leo): handle case where n is too big */
unsigned _n = force_to_unsigned(n);
parray<vm_obj> a(_n, v);
return to_obj(a);
}
vm_obj mk_vm_exceptional_exception(throwable const & ex) {
vm_obj _ex = to_obj(ex);
return mk_vm_constructor(1, mk_vm_closure(g_throwable_to_format_fun_idx, 1, &_ex));
}
vm_obj level_imax(vm_obj const & o1, vm_obj const & o2) {
return to_obj(mk_imax(to_level(o1), to_level(o2)));
}
vm_obj level_param(vm_obj const & n) {
return to_obj(mk_param_univ(to_name(n)));
}
static vm_obj mk_result(fun_info const & info, vm_obj const & s) {
return tactic::mk_success(to_obj(info), tactic::to_state(s));
}
static vm_obj mk_result(list<ss_param_info> const & info, vm_obj const & s) {
return tactic::mk_success(to_obj(info), tactic::to_state(s));
}
vm_obj level_global(vm_obj const & n) {
return to_obj(mk_global_univ(to_name(n)));
}
