void test2() {
ast_manager m;
reg_decl_plugins(m);
bv_util bv(m);
datatype_util dtutil(m);
params_ref p;
datatype_decl_plugin & dt = *(static_cast<datatype_decl_plugin*>(m.get_plugin(m.get_family_id("datatype"))));
sort_ref_vector new_sorts(m);
constructor_decl* R = mk_constructor_decl(symbol("R"), symbol("is-R"), 0, nullptr);
constructor_decl* G = mk_constructor_decl(symbol("G"), symbol("is-G"), 0, nullptr);
constructor_decl* B = mk_constructor_decl(symbol("B"), symbol("is-B"), 0, nullptr);
constructor_decl* constrs[3] = { R, G, B };
datatype_decl * enum_sort = mk_datatype_decl(dtutil, symbol("RGB"), 0, nullptr, 3, constrs);
VERIFY(dt.mk_datatypes(1, &enum_sort, 0, nullptr, new_sorts));
sort* rgb = new_sorts[0].get();
expr_ref x = mk_const(m, "x", rgb), y = mk_const(m, "y", rgb), z = mk_const(m, "z", rgb);
ptr_vector<func_decl> const& enums = *dtutil.get_datatype_constructors(rgb);
expr_ref r = expr_ref(m.mk_const(enums[0]), m);
expr_ref g = expr_ref(m.mk_const(enums[1]), m);
expr_ref b = expr_ref(m.mk_const(enums[2]), m);
ref<solver> fd_solver = mk_fd_solver(m, p);
fd_solver->assert_expr(m.mk_not(m.mk_eq(x, r)));
fd_solver->assert_expr(m.mk_not(m.mk_eq(x, b)));
expr_ref_vector asms(m), vars(m), conseq(m);
vars.push_back(x);
vars.push_back(y);
VERIFY(l_true == fd_solver->get_consequences(asms, vars, conseq));
std::cout << conseq << "\n";
conseq.reset();
fd_solver->push();
fd_solver->assert_expr(m.mk_not(m.mk_eq(x, g)));
VERIFY(l_false == fd_solver->check_sat(0,nullptr));
fd_solver->pop(1);
VERIFY(l_true == fd_solver->get_consequences(asms, vars, conseq));
std::cout << conseq << "\n";
conseq.reset();
model_ref mr;
fd_solver->get_model(mr);
model_smt2_pp(std::cout << "model:\n", m, *mr.get(), 0);
VERIFY(l_true == fd_solver->check_sat(0,nullptr));
fd_solver->get_model(mr);
ENSURE(mr.get());
model_smt2_pp(std::cout, m, *mr.get(), 0);
}
br_status reduce_app(func_decl * f, unsigned num, expr * const * args, expr_ref & result, proof_ref & result_pr) {
result_pr = 0;
if (num == 0 && f->get_family_id() == null_family_id && butil().is_bv_sort(f->get_range())) {
mk_const(f, result);
return BR_DONE;
}
if (m().is_eq(f)) {
SASSERT(num == 2);
if (butil().is_bv(args[0])) {
reduce_eq(args[0], args[1], result);
return BR_DONE;
}
return BR_FAILED;
}
if (m().is_ite(f)) {
SASSERT(num == 3);
if (butil().is_bv(args[1])) {
reduce_ite(args[0], args[1], args[2], result);
return BR_DONE;
}
return BR_FAILED;
}
if (f->get_family_id() == butil().get_family_id()) {
switch (f->get_decl_kind()) {
case OP_BV_NUM:
reduce_num(f, result);
return BR_DONE;
case OP_EXTRACT:
SASSERT(num == 1);
reduce_extract(f, args[0], result);
return BR_DONE;
case OP_CONCAT:
reduce_concat(num, args, result);
return BR_DONE;
case OP_BXOR:
reduce_xor(num, args, result);
return BR_DONE;
default:
UNREACHABLE();
return BR_FAILED;
}
}
if (butil().is_bv_sort(f->get_range())) {
blast_bv_term(m().mk_app(f, num, args), result);
return BR_DONE;
}
return BR_FAILED;
}
static void add_flow_list P4 (FLOWLISTENTRY **, RegUsage, REG, reg, ADDRESS *,
ap, ITYPE, type)
{
FLOWLISTENTRY *Entry;
ADDRESS *ap1;
IVAL offset;
if ((ap->mode == am_ainc) || (ap->mode == am_adec)) {
/* ainc could be treated as am_indx with offset = -increment
* in list, sinc addressregister points increment farther than
* value was written
* except it was stored with itself (arn, *arn++)
*/
if ((ap->preg == reg)
|| (ap->u.offset->nodetype != en_icon)) {
return;
}
ap1 = copy_addr (ap, am_indx);
offset =
(ap->mode == am_ainc) ? -ap->u.offset->v.i : ap->u.offset->v.i;
ap1->u.offset = mk_const ((long) offset);
ap = ap1;
}
if ((ap->mode == am_preinc) || (ap->mode == am_predec)) {
/* preinc could be treated as am_ind in list, sinc
* addressregister points still to the same location
* except it was stored with itself (arn, *++arn)
*/
if (ap->preg == reg) {
return;
}
ap = copy_addr (ap, am_ind);
}
/*
* check if equivalent entry is already in list
*/
if (search_flowlist_entry (*RegUsage, ap, type) == NULL) {
Entry = (FLOWLISTENTRY *) xalloc ((size_t) sizeof (FLOWLISTENTRY));
Entry->ap = ap;
#ifdef NO_MIX_WITH_FLOAT
Entry->type = type;
#endif
Entry->next = *RegUsage;
*RegUsage = Entry;
}
}
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);
}
static void new_flow_list P4 (FLOWLISTENTRY **, RegUsage, REG, reg, ADDRESS *,
ap, ITYPE, type)
{
FLOWLISTENTRY *Entry;
ADDRESS *ap1;
IVAL offset;
switch (ap->mode) {
case am_indx2:
case am_indxs:
if (ap->sreg == reg) {
*RegUsage = NULL;
return;
}
/*FALLTHRU */
case am_ind:
case am_const_ind:
case am_indx:
if (ap->preg == reg) {
*RegUsage = NULL;
return;
}
break;
case am_preinc:
case am_predec:
/*
* preinc could be treated as am_ind in list, sinc
* addressregister points still to the same location
* except it was loaded with itself (*++arn, arn)
*/
if (ap->preg == reg) {
*RegUsage = NULL;
return;
}
ap = copy_addr (ap, am_ind);
break;
case am_ainc:
case am_adec:
/*
* ainc could be treated as am_indx with offset = -increment
* in list, sinc addressregister points increment farther than
* value was written
* except it was loaded with itself (*arn++, arn)
*/
if ((ap->preg == reg)
|| (ap->u.offset->nodetype != en_icon)) {
*RegUsage = NULL;
return;
}
ap1 = copy_addr (ap, am_indx);
offset =
(ap->mode == am_ainc) ? -ap->u.offset->v.i : ap->u.offset->v.i;
ap1->u.offset = mk_const (offset);
ap = ap1;
break;
default:
break;
}
Entry = (FLOWLISTENTRY *) xalloc ((size_t) sizeof (FLOWLISTENTRY));
Entry->ap = ap;
#ifdef NO_MIX_WITH_FLOAT
Entry->type = type;
#endif
Entry->next = NULL;
*RegUsage = Entry;
}
