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(); }
expr apply(expr const & a) { bool sh = false; if (is_shared(a)) { auto r = m_cache.find(a.raw()); if (r != m_cache.end()) return r->second; sh = true; } switch (a.kind()) { case expr_kind::Var: case expr_kind::Constant: case expr_kind::Type: case expr_kind::Value: return save_result(a, copy(a), sh); case expr_kind::App: { buffer<expr> new_args; for (expr const & old_arg : args(a)) new_args.push_back(apply(old_arg)); return save_result(a, mk_app(new_args), sh); } case expr_kind::HEq: return save_result(a, mk_heq(apply(heq_lhs(a)), apply(heq_rhs(a))), sh); case expr_kind::Pair: return save_result(a, mk_pair(apply(pair_first(a)), apply(pair_second(a)), apply(pair_type(a))), sh); case expr_kind::Proj: return save_result(a, mk_proj(proj_first(a), apply(proj_arg(a))), sh); case expr_kind::Lambda: return save_result(a, mk_lambda(abst_name(a), apply(abst_domain(a)), apply(abst_body(a))), sh); case expr_kind::Pi: return save_result(a, mk_pi(abst_name(a), apply(abst_domain(a)), apply(abst_body(a))), sh); case expr_kind::Sigma: return save_result(a, mk_sigma(abst_name(a), apply(abst_domain(a)), apply(abst_body(a))), sh); case expr_kind::Let: return save_result(a, mk_let(let_name(a), apply(let_type(a)), apply(let_value(a)), apply(let_body(a))), sh); case expr_kind::MetaVar: return save_result(a, update_metavar(a, [&](local_entry const & e) -> local_entry { if (e.is_inst()) return mk_inst(e.s(), apply(e.v())); else return e; }), sh); } lean_unreachable(); // LCOV_EXCL_LINE }
expr mk_arrow(expr const & t, expr const & e, tag g) { return mk_pi(get_default_var_name(), t, e, binder_info(), g); }
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); }