append (struct coroutine *k,
expr a, expr b, expr c)
{
begin_decl ();
decl_expr (&a);
decl_expr (&b);
decl_expr (&c);
if (alt (k, 1, 0))
/* append ([], L, L) */
{
expr l, var_l;
decl_loc (l);
decl_loc (var_l);
l = UNDEF;
var_l = mk_var (&l);
unify (k, nil, a);
unify (k, var_l, b);
unify (k, var_l, c);
unify (k, a, nil);
unify (k, b, var_l);
unify (k, c, var_l);
}
else
/* append ([X|A], B, [X|C]) :- append (A, B, C) */
if (alt (k, 1, 0))
{
expr X, A, B, C, _X, _A, _B, _C, XA, XC;
dle(X) dle(A) dle(B) dle(X)
dle(_X) dle(_A) dle(_B) dle(_C)
dle(XA) dle(XC)
X = UNDEF;
A = UNDEF;
B = UNDEF;
C = UNDEF;
_X = mk_var (&X);
_A = mk_var (&A);
_B = mk_var (&B);
_C = mk_var (&C);
XA = cons (_X, _A);
XC = cons (_X, _C);
unify (k, XA, a);
unify (k, _B, b);
unify (k, XC, c);
append (k, _A, _B, _C);
unify (k, a, XA);
unify (k, b, _B);
unify (k, c, XC);
} else
end (k);
free_expr ();
}
void expr2linear_pol(expr * t, mpq_buffer & as, var_buffer & xs) {
mpq c_mpq_val;
if (m_util.is_add(t)) {
rational c_val;
unsigned num = to_app(t)->get_num_args();
for (unsigned i = 0; i < num; i++) {
expr * mon = to_app(t)->get_arg(i);
expr * c, * x;
if (m_util.is_mul(mon, c, x) && m_util.is_numeral(c, c_val)) {
nm.set(c_mpq_val, c_val.to_mpq());
as.push_back(c_mpq_val);
xs.push_back(mk_var(x));
}
else {
as.push_back(mpq(1));
xs.push_back(mk_var(mon));
}
}
}
else {
as.push_back(mpq(1));
xs.push_back(mk_var(t));
}
nm.del(c_mpq_val);
}
// process t1 - t2 != k
void process_neq_core(expr * t1, expr * t2, int k) {
var x1 = mk_var(t1);
var x2 = mk_var(t2);
if (x1 == x2)
throw_not_supported(); // must simplify first
if (x1 < x2) {
std::swap(x1, x2);
k = -k;
}
m_var_diseqs[x1].push_back(diseq(x2, k));
}
static void emit_branch(char *b, char *g, char *e, char *n, int sz, const char *dst) {
char *p, str[64];
char *arg = NULL;
char *op = "beq";
/* NOTE that jb/ja are inverted to fit cmp opcode */
if (b) {
*b = '\0';
op = e?"bge":"bgt";
arg = b+1;
} else
if (g) {
*g = '\0';
op = e?"ble":"blt";
arg = g+1;
}
if (arg == NULL) {
if (e) {
arg = e+1;
op = "bne";
} else {
arg = "0";
op = n?"bne":"beq";
}
}
if (*arg=='=') arg++; /* for <=, >=, ... */
p = mk_var (str, arg, 0);
rcc_printf (" pop "R_AX"\n"); /* TODO: add support for more than one arg get arg0 */
rcc_printf (" cmp %s, "R_AX"\n", p);
// if (context>0)
rcc_printf (" %s %s\n", op, dst);
}
pl_goal_0 (struct coroutine *k)
{
expr nx[MAX_NEW_CONS];
int pnx, i;
struct process_list *alt_process;
pnx = 0;
begin_decl ();
for (i=0; i<MAX_NEW_CONS; i++)
dle (nx[i]);
#ifdef TRACE
#endif
if (alt (k, 1, 0))
{
/* clause */
expr val_X, var_X;
alt_process = getpl (k) -> alt;
dle(val_X) dle(var_X)
val_X=UNDEF; var_X=mk_var(&val_X);
#ifdef TRACE
#endif
pl_consonne_1 (k, var_X);
for (i=0; i<pnx; i++)
nx[i] = 0;
pnx=0;
pl_printexpr_1 (k, var_X);
for (i=0; i<pnx; i++)
nx[i] = 0;
pnx=0;
#ifdef TRACE
#endif
} else
end (k);
free_expr ();
}
optional<expr> expand_core(expr const & e) {
lean_assert(!is_lambda(e));
expr t = ctx().whnf(ctx().infer(e));
if (!is_pi(t))
return none_expr();
expr r = mk_lambda(name("x"), binding_domain(t), mk_app(e, mk_var(0)));
return some_expr(visit(r));
}
expr mk_app_vars(expr const & f, unsigned n, tag g) {
expr r = f;
while (n > 0) {
--n;
r = mk_app(r, mk_var(n, g), g);
}
return r;
}
SOLVER_TERM mk_array_var(SOLVER_CONTEXT ctx, const char * name){
Z3_context z3ctx = (Z3_context) ctx;
// Indexes are integers
Z3_sort tind = Z3_mk_int_sort(z3ctx);
// Values are integers (for the moment)
Z3_sort tval = Z3_mk_int_sort(z3ctx);
// Declaration of array
Z3_sort ty = Z3_mk_array_sort(z3ctx, tind, tval);
return (SOLVER_TERM) mk_var(z3ctx, name, ty);
}
void process_le(expr * lhs, expr * rhs) {
if (!u.is_int(lhs))
throw_not_supported();
rational k;
if (is_uninterp_const(lhs) && u.is_numeral(rhs, k) && m_max_neg_k <= k && k <= m_max_k) {
var x = mk_var(lhs);
int _k = static_cast<int>(k.get_int64());
m_upper[x] = _k;
}
else if (is_uninterp_const(rhs) && u.is_numeral(lhs, k) && m_max_neg_k <= k && k <= m_max_k) {
var x = mk_var(rhs);
int _k = static_cast<int>(k.get_int64());
m_lower[x] = _k;
}
else {
throw_not_supported();
}
}
static void mk_term(vector<var_t> const& vars, rational const& coeff, app_ref& term) {
ast_manager& m = term.get_manager();
expr_ref_vector ts(m);
arith_util a(m);
for (unsigned i = 0; i < vars.size(); ++i) {
app_ref var(m);
mk_var(vars[i].m_id, var);
rational coeff = vars[i].m_coeff;
ts.push_back(a.mk_mul(a.mk_numeral(coeff, false), var));
}
ts.push_back(a.mk_numeral(coeff, a.mk_real()));
term = a.mk_add(ts.size(), ts.c_ptr());
}
expr copy(expr const & a) {
switch (a.kind()) {
case expr_kind::Var: return mk_var(var_idx(a));
case expr_kind::Constant: return mk_constant(const_name(a));
case expr_kind::Type: return mk_type(ty_level(a));
case expr_kind::Value: return mk_value(static_cast<expr_value*>(a.raw())->m_val);
case expr_kind::App: return mk_app(num_args(a), begin_args(a));
case expr_kind::Eq: return mk_eq(eq_lhs(a), eq_rhs(a));
case expr_kind::Lambda: return mk_lambda(abst_name(a), abst_domain(a), abst_body(a));
case expr_kind::Pi: return mk_pi(abst_name(a), abst_domain(a), abst_body(a));
case expr_kind::Let: return mk_let(let_name(a), let_type(a), let_value(a), let_body(a));
case expr_kind::MetaVar: return mk_metavar(metavar_idx(a), metavar_ctx(a));
}
lean_unreachable();
}
a_var mk_linear_pol(expr * t) {
a_var x;
if (m_expr2var.find(t, x))
return x;
x = mk_var(t);
if (m_util.is_add(t)) {
m_num_buffer.reset();
m_var_buffer.reset();
expr2linear_pol(t, m_num_buffer, m_var_buffer);
m_num_buffer.push_back(mpq(-1));
m_var_buffer.push_back(x);
bp.mk_eq(m_num_buffer.size(), m_num_buffer.c_ptr(), m_var_buffer.c_ptr());
}
return x;
}
static void test_maximize(opt::model_based_opt& mbo, ast_manager& m, unsigned num_vars, expr_ref_vector const& fmls, app* t) {
qe::arith_project_plugin plugin(m);
model mdl(m);
arith_util a(m);
for (unsigned i = 0; i < num_vars; ++i) {
app_ref var(m);
mk_var(i, var);
rational val = mbo.get_value(i);
mdl.register_decl(var->get_decl(), a.mk_numeral(val, false));
}
expr_ref ge(m), gt(m);
opt::inf_eps value1 = plugin.maximize(fmls, mdl, t, ge, gt);
opt::inf_eps value2 = mbo.maximize();
std::cout << "optimal: " << value1 << " " << value2 << "\n";
mbo.display(std::cout);
}
pl_consonne_1 (struct coroutine *k, expr a0)
{
expr nx[MAX_NEW_CONS];
int pnx, i;
struct process_list *alt_process;
pnx = 0;
begin_decl ();
decl_expr (&a0);
for (i=0; i<MAX_NEW_CONS; i++)
dle (nx[i]);
#ifdef TRACE
printf ("\nconsonne: a0 = "); print_expr (a0);
#endif
if (alt (k, 1, 0))
{
/* clause */
expr val_X, var_X;
alt_process = getpl (k) -> alt;
dle(val_X) dle(var_X)
val_X=UNDEF; var_X=mk_var(&val_X);
#ifdef TRACE
printf ("\n\ta0 = "); print_expr (a0);
#endif
unify (k, var_X, a0);
for (i=0; i<pnx; i++)
nx[i] = 0;
pnx=0;
pl_lettre_1 (k, var_X);
for (i=0; i<pnx; i++)
nx[i] = 0;
pnx=0;
pl_non_voyelle_1 (k, var_X);
for (i=0; i<pnx; i++)
nx[i] = 0;
pnx=0;
unify (k, a0, var_X);
for (i=0; i<pnx; i++)
nx[i] = 0;
pnx=0;
#ifdef TRACE
printf ("\n\ta0 = "); print_expr (a0);
#endif
} else
end (k);
free_expr ();
}
static void emit_set_string(const char *dstvar, const char *str, int j) {
int rest, off = 0;
off = strlen (str)+1;
rest = (off%4);
if (rest) rest = 4-rest;
off += rest-8;
rcc_printf (" add pc, $%d\n", (off));
// XXX: does not handle \n and so on.. must use r_util
rcc_printf (".string \"%s\"\n", str);
if (rest) rcc_printf (".fill %d, 1, 0\n", (rest));
rcc_printf (" sub r0, pc, $%d\n", off+16);
{
char str[32], *p = mk_var (str, dstvar, 0);
//rcc_printf("DSTVAR=%s --> %s\n", dstvar, p);
rcc_printf (" str r0, [%s]\n", p);
}
}
void initialize_resolve_macro() {
g_resolve_macro_name = new name("resolve");
g_resolve_opcode = new std::string("Res");
g_or = new expr(Const(get_or_name()));
g_not = new expr(Const(get_not_name()));
g_false = new expr(Const(get_false_name()));
g_or_elim = new expr(Const(get_or_elim_name()));
g_or_intro_left = new expr(Const(get_or_intro_left_name()));
g_or_intro_right = new expr(Const(get_or_intro_right_name()));
g_absurd_elim = new expr(Const(get_absurd_name()));
g_var_0 = new expr(mk_var(0));
g_resolve_macro_definition = new macro_definition(new resolve_macro_definition_cell());
register_macro_deserializer(*g_resolve_opcode,
[](deserializer &, unsigned num, expr const * args) {
if (num != 3)
throw corrupted_stream_exception();
return mk_resolve_macro(args[0], args[1], args[2]);
});
}
append (struct coroutine *k,
expr a, expr b, expr c)
{
#ifndef OLD
begin_decl ();
decl_expr (&a);
decl_expr (&b);
decl_expr (&c);
#endif
#ifdef TRACE
printf ("\na = "); print_expr (a);
printf ("\nb = "); print_expr (b);
printf ("\nc = "); print_expr (c);
#endif
if (alt (k, 1, 0))
/* append ([], L, L) */
{
expr l, var_l;
#ifndef OLD
decl_loc (l);
decl_loc (var_l);
#endif
l = UNDEF;
var_l = mk_var (&l);
unify (k, nil, a);
unify (k, var_l, b);
unify (k, var_l, c);
#ifdef TRACE
printf ("\nvar_l = "); print_expr (var_l);
#endif
unify (k, a, nil);
unify (k, b, var_l);
unify (k, c, var_l);
#ifdef TRACE
printf ("\na = "); print_expr (a);
printf ("\nb = "); print_expr (b);
printf ("\nc = "); print_expr (c);
#endif
/* free (var_l); */
}
else
/* append ([X|A], B, [X|C]) :- append (A, B, C) */
{
expr X, A, B, C, _X, _A, _B, _C, XA, XC;
#ifndef OLD
dle(X) dle(A) dle(B) dle(X)
dle(_X) dle(_A) dle(_B) dle(_C)
dle(XA) dle(XC)
#endif
X = UNDEF;
A = UNDEF;
B = UNDEF;
C = UNDEF;
_X = mk_var (&X);
_A = mk_var (&A);
_B = mk_var (&B);
_C = mk_var (&C);
XA = cons (_X, _A);
XC = cons (_X, _C);
#ifdef TRACE
printf ("\nXA = "); print_expr (XA);
printf ("\n_B = "); print_expr (_B);
printf ("\nXC = "); print_expr (XC);
printf ("\na = "); print_expr (a);
printf ("\nb = "); print_expr (b);
printf ("\nc = "); print_expr (c);
#endif
unify (k, XA, a);
unify (k, _B, b);
unify (k, XC, c);
#ifdef TRACE
printf ("\nXA = "); print_expr (XA);
printf ("\n_B = "); print_expr (_B);
printf ("\nXC = "); print_expr (XC);
#endif
append (k, _A, _B, _C);
#ifdef TRACE
printf ("\n_A = "); print_expr (_A);
printf ("\n_B = "); print_expr (_B);
printf ("\n_C = "); print_expr (_C);
printf ("\nXA = "); print_expr (XA);
printf ("\n_B = "); print_expr (_B);
printf ("\nXC = "); print_expr (XC);
#endif
unify (k, a, XA);
unify (k, b, _B);
unify (k, c, XC);
#ifdef TRACE
printf ("\na = "); print_expr (a);
printf ("\nb = "); print_expr (b);
printf ("\nc = "); print_expr (c);
#endif
/*
free (_X);
free (_A);
free (_B);
free (_C);
free (XA);
free (XC);
*/
}
#ifndef OLD
free_expr ();
#endif
}
static Z3_ast mk_int_var(Z3_context ctx, char const* name) {
return mk_var(ctx, name, Z3_mk_int_sort(ctx));
}
void aig_exporter::operator()(std::ostream& out) {
expr_ref_vector transition_function(m), output_preds(m);
var_ref_vector input_vars(m);
rule_counter& vc = m_rm.get_counter();
expr_ref_vector exprs(m);
substitution subst(m);
for (rule_set::decl2rules::iterator I = m_rules.begin_grouped_rules(),
E = m_rules.end_grouped_rules(); I != E; ++I) {
for (rule_vector::iterator II = I->get_value()->begin(),
EE = I->get_value()->end(); II != EE; ++II) {
rule *r = *II;
unsigned numqs = r->get_positive_tail_size();
if (numqs > 1) {
std::cerr << "non-linear clauses not supported\n";
exit(-1);
}
if (numqs != r->get_uninterpreted_tail_size()) {
std::cerr << "negation of queries not supported\n";
exit(-1);
}
exprs.reset();
assert_pred_id(numqs ? r->get_tail(0)->get_decl() : 0, m_ruleid_var_set, exprs);
assert_pred_id(r->get_head()->get_decl(), m_ruleid_varp_set, exprs);
subst.reset();
subst.reserve(1, vc.get_max_rule_var(*r)+1);
if (numqs)
collect_var_substs(subst, r->get_tail(0), m_latch_vars, exprs);
collect_var_substs(subst, r->get_head(), m_latch_varsp, exprs);
for (unsigned i = numqs; i < r->get_tail_size(); ++i) {
expr_ref e(m);
subst.apply(r->get_tail(i), e);
exprs.push_back(e);
}
transition_function.push_back(m.mk_and(exprs.size(), exprs.c_ptr()));
}
}
// collect table facts
if (m_facts) {
for (fact_vector::const_iterator I = m_facts->begin(), E = m_facts->end(); I != E; ++I) {
exprs.reset();
assert_pred_id(0, m_ruleid_var_set, exprs);
assert_pred_id(I->first, m_ruleid_varp_set, exprs);
for (unsigned i = 0; i < I->second.size(); ++i) {
exprs.push_back(m.mk_eq(get_latch_var(i, m_latch_varsp), I->second[i]));
}
transition_function.push_back(m.mk_and(exprs.size(), exprs.c_ptr()));
}
}
expr *tr = m.mk_or(transition_function.size(), transition_function.c_ptr());
aig_ref aig = m_aigm.mk_aig(tr);
expr_ref aig_expr(m);
m_aigm.to_formula(aig, aig_expr);
#if 0
std::cout << mk_pp(tr, m) << "\n\n";
std::cout << mk_pp(aig_expr, m) << "\n\n";
#endif
// make rule_id vars latches
for (unsigned i = 0; i < m_ruleid_var_set.size(); ++i) {
m_latch_vars.push_back(m_ruleid_var_set.get(i));
m_latch_varsp.push_back(m_ruleid_varp_set.get(i));
}
// create vars for latches
for (unsigned i = 0; i < m_latch_vars.size(); ++i) {
mk_var(m_latch_vars.get(i));
mk_input_var(m_latch_varsp.get(i));
}
unsigned tr_id = expr_to_aig(aig_expr);
// create latch next state variables: (ite tr varp var)
unsigned_vector latch_varp_ids;
for (unsigned i = 0; i < m_latch_vars.size(); ++i) {
unsigned in_val = mk_and(tr_id, get_var(m_latch_varsp.get(i)));
unsigned latch_val = mk_and(neg(tr_id), get_var(m_latch_vars.get(i)));
latch_varp_ids.push_back(mk_or(in_val, latch_val));
}
m_latch_varsp.reset();
// create output variable (true iff an output predicate is derivable)
unsigned output_id = 0;
{
expr_ref_vector output(m);
const func_decl_set& preds = m_rules.get_output_predicates();
for (func_decl_set::iterator I = preds.begin(), E = preds.end(); I != E; ++I) {
exprs.reset();
assert_pred_id(*I, m_ruleid_var_set, exprs);
output.push_back(m.mk_and(exprs.size(), exprs.c_ptr()));
}
expr *out = m.mk_or(output.size(), output.c_ptr());
aig = m_aigm.mk_aig(out);
m_aigm.to_formula(aig, aig_expr);
output_id = expr_to_aig(aig_expr);
#if 0
std::cout << "output formula\n";
std::cout << mk_pp(out, m) << "\n\n";
std::cout << mk_pp(aig_expr, m) << "\n\n";
#endif
}
// 1) print header
// aag var_index inputs latches outputs andgates
out << "aag " << (m_next_aig_expr_id-1)/2 << ' ' << m_input_vars.size()
<< ' ' << m_latch_vars.size() << " 1 " << m_num_and_gates << '\n';
// 2) print inputs
for (unsigned i = 0; i < m_input_vars.size(); ++i) {
out << m_input_vars[i] << '\n';
}
// 3) print latches
for (unsigned i = 0; i < m_latch_vars.size(); ++i) {
out << get_var(m_latch_vars.get(i)) << ' ' << latch_varp_ids[i] << '\n';
}
// 4) print outputs (just one for now)
out << output_id << '\n';
// 5) print formula
out << m_buffer.str();
}
/**
\brief Create a boolean variable using the given name.
*/
Z3_ast mk_bool_var(Z3_context ctx, const char * name)
{
Z3_sort ty = Z3_mk_bool_sort(ctx);
return mk_var(ctx, name, ty);
}
void test_inductive() {
// declare list type
lean_exception ex = 0;
lean_env env = mk_env();
lean_name l_name = mk_name("l");
lean_univ l = mk_uparam("l");
lean_univ one = mk_one();
lean_univ m1l = mk_max(one, l);
lean_expr Typel = mk_sort(l);
lean_expr Typem1l = mk_sort(m1l);
lean_expr list_type = mk_pi("A", Typel, Typem1l);
lean_name list_name = mk_name("list");
lean_expr list = mk_const("list", l);
lean_expr v0 = mk_var(0);
// nil : Pi (A : Type.{l}), list.{l} A
lean_expr list_v0 = mk_app(list, v0);
lean_expr nil_type = mk_pi("A", Typel, list_v0);
lean_expr nil = mk_local("nil", nil_type);
// cons : Pi (A : Type.{l}), A -> list.{l} A -> list.{l} A
lean_expr v1 = mk_var(1);
lean_expr v2 = mk_var(2);
lean_expr list_v2 = mk_app(list, v2);
lean_expr list_v1 = mk_app(list, v1);
lean_expr cons_type1 = mk_pi("tail", list_v1, list_v2);
lean_expr cons_type2 = mk_pi("head", v0, cons_type1);
lean_expr cons_type = mk_pi("A", Typel, cons_type2);
lean_expr cons = mk_local("cons", cons_type);
//
lean_list_expr cs1, cs2, list_cs;
lean_inductive_type list_ind_type;
lean_list_inductive_type li1, list_ind_types;
lean_list_name ls1, ls;
lean_inductive_decl list_decl;
lean_env new_env;
check(lean_list_name_mk_nil(&ls1, &ex));
check(lean_list_name_mk_cons(l_name, ls1, &ls, &ex));
check(lean_list_expr_mk_nil(&cs1, &ex));
check(lean_list_expr_mk_cons(nil, cs1, &cs2, &ex));
check(lean_list_expr_mk_cons(cons, cs2, &list_cs, &ex));
check(lean_inductive_type_mk(list_name, list_type, list_cs, &list_ind_type, &ex));
check(lean_list_inductive_type_mk_nil(&li1, &ex));
check(lean_list_inductive_type_mk_cons(list_ind_type, li1, &list_ind_types, &ex));
check(lean_inductive_decl_mk(ls, 1, list_ind_types, &list_decl, &ex));
check(lean_env_add_inductive(env, list_decl, &new_env, &ex));
{
unsigned n;
lean_inductive_decl d;
lean_name cons_name = mk_name("cons");
lean_name r_name;
lean_list_inductive_type types;
check(lean_env_get_inductive_type_num_indices(new_env, list_name, &n, &ex) && n == 0);
check(lean_env_get_inductive_type_num_minor_premises(new_env, list_name, &n, &ex) && n == 2);
check(!lean_env_is_inductive_type(env, list_name, &d, &ex));
check(lean_env_is_inductive_type(new_env, list_name, &d, &ex));
check(lean_inductive_decl_get_num_params(d, &n, &ex) && n == 1);
check(lean_inductive_decl_get_types(d, &types, &ex));
check(lean_list_inductive_type_is_cons(types));
check(lean_env_is_constructor(new_env, cons_name, &r_name, &ex) && lean_name_eq(list_name, r_name));
lean_inductive_decl_del(d);
lean_name_del(cons_name);
lean_name_del(r_name);
}
lean_env_del(env);
lean_name_del(list_name);
lean_name_del(l_name);
lean_univ_del(l);
lean_univ_del(one);
lean_univ_del(m1l);
lean_expr_del(Typel);
lean_expr_del(Typem1l);
lean_expr_del(list_type);
lean_expr_del(list);
lean_expr_del(v0);
lean_expr_del(list_v0);
lean_expr_del(nil_type);
lean_expr_del(nil);
lean_expr_del(v1);
lean_expr_del(v2);
lean_expr_del(list_v2);
lean_expr_del(list_v1);
lean_expr_del(cons_type1);
lean_expr_del(cons_type2);
lean_expr_del(cons_type);
lean_expr_del(cons);
lean_list_expr_del(cs1);
lean_list_expr_del(cs2);
lean_list_expr_del(list_cs);
lean_inductive_type_del(list_ind_type);
lean_list_inductive_type_del(li1);
lean_list_inductive_type_del(list_ind_types);
lean_list_name_del(ls1);
lean_list_name_del(ls);
lean_inductive_decl_del(list_decl);
lean_env_del(new_env);
}
void test_id() {
lean_exception ex;
lean_univ l = mk_uparam("l");
lean_env env = mk_env();
lean_expr v0 = mk_var(0);
lean_expr v1 = mk_var(1);
lean_expr AA = mk_pi("a", v0, v1);
lean_expr Type = mk_sort(l);
lean_expr id_type = mk_pi("A", Type, AA);
lean_expr f = mk_lambda("a", v0, v0);
lean_expr id_val = mk_lambda("A", Type, f);
lean_name l_name = mk_name("l");
lean_list_name id_ps = mk_unary_name_list(l_name);
lean_decl id_def = mk_def("id", id_ps, id_type, id_val);
lean_name id_name = mk_name("id");
lean_cert_decl id_cert_def;
lean_env new_env;
lean_univ zero, one;
lean_bool is_lt;
check(lean_expr_lt(f, id_val, &is_lt, &ex) && is_lt);
check(lean_expr_lt(id_val, f, &is_lt, &ex) && !is_lt);
printf("id type: ");
print_expr(id_type);
printf("id value: ");
print_expr(id_val);
printf("-------\n");
/* type check definition */
check(lean_decl_check(env, id_def, &id_cert_def, &ex));
/* add certified definition to environment */
check(lean_env_add(env, id_cert_def, &new_env, &ex));
check(!lean_env_contains_decl(env, id_name));
check(lean_env_contains_decl(new_env, id_name));
check(lean_env_for_each_decl(new_env, print_decl_and_del, &ex));
check(lean_univ_mk_zero(&zero, &ex));
check(lean_univ_mk_succ(zero, &one, &ex));
check(lean_univ_lt(zero, one, &is_lt, &ex) && is_lt);
check(lean_univ_lt(one, zero, &is_lt, &ex) && !is_lt);
{
lean_type_checker tc;
lean_expr T0 = mk_sort(zero);
lean_expr T1 = mk_sort(one);
lean_expr id1 = mk_const("id", one);
lean_expr id1T1, id1T1T0;
lean_expr n1;
lean_cnstr_seq s1;
check(lean_expr_mk_app(id1, T1, &id1T1, &ex));
check(lean_expr_mk_app(id1T1, T0, &id1T1T0, &ex));
check(lean_type_checker_mk(new_env, &tc, &ex));
printf("WHNF test\n");
print_expr(id1T1T0);
check(lean_type_checker_whnf(tc, id1T1T0, &n1, &s1, &ex));
printf("=====>\n");
print_expr(n1);
lean_expr_del(n1);
lean_cnstr_seq_del(s1);
printf("Infer type test\n");
print_expr(id1T1);
check(lean_type_checker_infer(tc, id1T1, &n1, &s1, &ex));
printf("=====>\n");
print_expr(n1);
lean_expr_del(n1);
lean_cnstr_seq_del(s1);
lean_type_checker_del(tc);
lean_expr_del(T0);
lean_expr_del(T1);
lean_expr_del(id1);
lean_expr_del(id1T1);
lean_expr_del(id1T1T0);
}
lean_univ_del(l);
lean_env_del(env);
lean_expr_del(v0);
lean_expr_del(v1);
lean_expr_del(Type);
lean_expr_del(AA);
lean_expr_del(id_type);
lean_expr_del(f);
lean_expr_del(id_val);
lean_decl_del(id_def);
lean_list_name_del(id_ps);
lean_name_del(l_name);
lean_cert_decl_del(id_cert_def);
lean_env_del(new_env);
lean_name_del(id_name);
lean_univ_del(zero);
lean_univ_del(one);
}
SOLVER_TERM mk_int_var(SOLVER_CONTEXT ctx, const char * name){
Z3_context z3ctx = (Z3_context) ctx;
Z3_sort ty = Z3_mk_int_sort(z3ctx);
return (SOLVER_TERM) mk_var(z3ctx, name, ty);
}
environment mk_projections(environment const & env, name const & n, buffer<name> const & proj_names,
implicit_infer_kind infer_k, bool inst_implicit) {
// Given an inductive datatype C A (where A represent parameters)
// intro : Pi A (x_1 : B_1[A]) (x_2 : B_2[A, x_1]) ..., C A
//
// we generate projections of the form
// proj_i A (c : C A) : B_i[A, (proj_1 A n), ..., (proj_{i-1} A n)]
// C.rec A (fun (x : C A), B_i[A, ...]) (fun (x_1 ... x_n), x_i) c
auto p = get_nparam_intro_rule(env, n);
name_generator ngen;
unsigned nparams = p.first;
inductive::intro_rule intro = p.second;
expr intro_type = inductive::intro_rule_type(intro);
name rec_name = inductive::get_elim_name(n);
declaration ind_decl = env.get(n);
if (env.impredicative() && is_prop(ind_decl.get_type()))
throw exception(sstream() << "projection generation, '" << n << "' is a proposition");
declaration rec_decl = env.get(rec_name);
level_param_names lvl_params = ind_decl.get_univ_params();
levels lvls = param_names_to_levels(lvl_params);
buffer<expr> params; // datatype parameters
for (unsigned i = 0; i < nparams; i++) {
if (!is_pi(intro_type))
throw_ill_formed(n);
expr param = mk_local(ngen.next(), binding_name(intro_type), binding_domain(intro_type), binder_info());
intro_type = instantiate(binding_body(intro_type), param);
params.push_back(param);
}
expr C_A = mk_app(mk_constant(n, lvls), params);
binder_info c_bi = inst_implicit ? mk_inst_implicit_binder_info() : binder_info();
expr c = mk_local(ngen.next(), name("c"), C_A, c_bi);
buffer<expr> intro_type_args; // arguments that are not parameters
expr it = intro_type;
while (is_pi(it)) {
expr local = mk_local(ngen.next(), binding_name(it), binding_domain(it), binding_info(it));
intro_type_args.push_back(local);
it = instantiate(binding_body(it), local);
}
buffer<expr> projs; // projections generated so far
unsigned i = 0;
environment new_env = env;
for (name const & proj_name : proj_names) {
if (!is_pi(intro_type))
throw exception(sstream() << "generating projection '" << proj_name << "', '"
<< n << "' does not have sufficient data");
expr result_type = binding_domain(intro_type);
buffer<expr> proj_args;
proj_args.append(params);
proj_args.push_back(c);
expr type_former = Fun(c, result_type);
expr minor_premise = Fun(intro_type_args, mk_var(intro_type_args.size() - i - 1));
expr major_premise = c;
type_checker tc(new_env);
level l = sort_level(tc.ensure_sort(tc.infer(result_type).first).first);
levels rec_lvls = append(to_list(l), lvls);
expr rec = mk_constant(rec_name, rec_lvls);
buffer<expr> rec_args;
rec_args.append(params);
rec_args.push_back(type_former);
rec_args.push_back(minor_premise);
rec_args.push_back(major_premise);
expr rec_app = mk_app(rec, rec_args);
expr proj_type = Pi(proj_args, result_type);
proj_type = infer_implicit_params(proj_type, nparams, infer_k);
expr proj_val = Fun(proj_args, rec_app);
bool opaque = false;
bool use_conv_opt = false;
declaration new_d = mk_definition(env, proj_name, lvl_params, proj_type, proj_val,
opaque, rec_decl.get_module_idx(), use_conv_opt);
new_env = module::add(new_env, check(new_env, new_d));
new_env = set_reducible(new_env, proj_name, reducible_status::Reducible);
new_env = add_unfold_c_hint(new_env, proj_name, nparams);
new_env = save_projection_info(new_env, proj_name, inductive::intro_rule_name(intro), nparams, i, inst_implicit);
expr proj = mk_app(mk_app(mk_constant(proj_name, lvls), params), c);
intro_type = instantiate(binding_body(intro_type), proj);
i++;
}
return new_env;
}
void init_structure_instance_parsing_rules(parse_table & r) {
expr x0 = mk_var(0);
r = r.add({notation::transition("{|", notation::mk_ext_action(parse_struct_curly_bar))}, x0);
r = r.add({notation::transition("⦃", notation::mk_ext_action(parse_struct_dcurly))}, x0);
}
