Ejemplo n.º 1
0
 bool apply(expr const & a, expr const & b) {
     if (is_eqp(a, b))          return true;
     if (a.hash() != b.hash())  return false;
     if (a.kind() != b.kind())  return false;
     if (is_var(a))             return var_idx(a) == var_idx(b);
     if (m_cache.check(a, b))
         return true;
     switch (a.kind()) {
     case expr_kind::Var:
         lean_unreachable(); // LCOV_EXCL_LINE
     case expr_kind::Constant:
         return
             const_name(a) == const_name(b) &&
             compare(const_levels(a), const_levels(b), [](level const & l1, level const & l2) { return l1 == l2; });
     case expr_kind::Meta:
         return
             mlocal_name(a) == mlocal_name(b) &&
             apply(mlocal_type(a), mlocal_type(b));
     case expr_kind::Local:
         return
             mlocal_name(a) == mlocal_name(b) &&
             apply(mlocal_type(a), mlocal_type(b)) &&
             (!CompareBinderInfo || local_pp_name(a) == local_pp_name(b)) &&
             (!CompareBinderInfo || local_info(a) == local_info(b));
     case expr_kind::App:
         check_system();
         return
             apply(app_fn(a), app_fn(b)) &&
             apply(app_arg(a), app_arg(b));
     case expr_kind::Lambda: case expr_kind::Pi:
         check_system();
         return
             apply(binding_domain(a), binding_domain(b)) &&
             apply(binding_body(a), binding_body(b)) &&
             (!CompareBinderInfo || binding_name(a) == binding_name(b)) &&
             (!CompareBinderInfo || binding_info(a) == binding_info(b));
     case expr_kind::Let:
         check_system();
         return
             apply(let_type(a), let_type(b)) &&
             apply(let_value(a), let_value(b)) &&
             apply(let_body(a), let_body(b)) &&
             (!CompareBinderInfo || let_name(a) == let_name(b));
     case expr_kind::Sort:
         return sort_level(a) == sort_level(b);
     case expr_kind::Macro:
         check_system();
         if (macro_def(a) != macro_def(b) || macro_num_args(a) != macro_num_args(b))
             return false;
         for (unsigned i = 0; i < macro_num_args(a); i++) {
             if (!apply(macro_arg(a, i), macro_arg(b, i)))
                 return false;
         }
         return true;
     }
     lean_unreachable(); // LCOV_EXCL_LINE
 }
Ejemplo n.º 2
0
static bool uses_name(name const & n, buffer<expr> const & locals) {
    for (expr const & local : locals) {
        if (is_local(local) && local_pp_name(local) == n)
            return true;
    }
    return false;
}
Ejemplo n.º 3
0
tactic revert_tactic(name const & n) {
    auto fn = [=](environment const &, io_state const &, proof_state const & s) -> optional<proof_state> {
        goals const & gs = s.get_goals();
        if (empty(gs)) {
            throw_no_goal_if_enabled(s);
            return none_proof_state();
        }
        goal  g          = head(gs);
        goals tail_gs    = tail(gs);
        if (auto p = g.find_hyp(n)) {
            expr const & h = p->first;
            unsigned i     = p->second;
            buffer<expr> hyps;
            g.get_hyps(hyps);
            hyps.erase(hyps.size() - i - 1);
            if (optional<expr> other_h = depends_on(i, hyps.end() - i, h)) {
                throw_tactic_exception_if_enabled(s, sstream() << "invalid 'revert' tactic, hypothesis '" << local_pp_name(*other_h)
                                                  << "' depends on '" << local_pp_name(h) << "'");
                return none_proof_state(); // other hypotheses depend on h
            }
            name_generator ngen = s.get_ngen();
            expr new_type = Pi(h, g.get_type());
            expr new_meta = mk_app(mk_metavar(ngen.next(), Pi(hyps, new_type)), hyps);
            goal new_g(new_meta, new_type);
            substitution new_subst = s.get_subst();
            assign(new_subst, g, mk_app(new_meta, h));
            proof_state new_s(s, goals(new_g, tail_gs), new_subst, ngen);
            return some_proof_state(new_s);
        } else {
            throw_tactic_exception_if_enabled(s, sstream() << "invalid 'revert' tactic, unknown hypothesis '" << n << "'");
            return none_proof_state();
        }
    };
    return tactic01(fn);
}
Ejemplo n.º 4
0
expr update_mlocal(expr const & e, expr const & new_type) {
    if (is_eqp(mlocal_type(e), new_type))
        return e;
    else if (is_metavar(e))
        return mk_metavar(mlocal_name(e), new_type, e.get_tag());
    else
        return mk_local(mlocal_name(e), local_pp_name(e), new_type, local_info(e), e.get_tag());
}
Ejemplo n.º 5
0
void assert_no_locals(name const & n, expr const & e) {
     if (!has_local(e))
        return;
    collected_locals ls;
    collect_locals(e, ls);

    lean_trace(name({"debug", "inductive_compiler"}),
               tout() << "\n\nerror: found locals in '" << n << "'\n" << e << "\n";
               for (expr const & l : ls.get_collected()) {
                   tout() << mlocal_name(l) << "." << local_pp_name(l) << " : " << mlocal_type(l) << "\n";
               });
Ejemplo n.º 6
0
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);
}
Ejemplo n.º 7
0
expr clear(metavar_context & mctx, expr const & mvar, expr const & H) {
    lean_assert(is_metavar(mvar));
    lean_assert(is_local(H));
    optional<metavar_decl> g   = mctx.get_metavar_decl(mvar);
    if (!g) throw exception("clear tactic failed, there are no goals to be solved");
    local_context lctx         = g->get_context();
    optional<local_decl> d     = lctx.get_local_decl(H);
    if (!d)
        throw exception(sstream() << "clear tactic failed, unknown '" << local_pp_name(H) << "' hypothesis");
    if (depends_on(g->get_type(), mctx, 1, &H))
        throw exception(sstream() << "clear tactic failed, target type depends on '" << local_pp_name(H) << "'");
    if (optional<local_decl> d2 = lctx.has_dependencies(*d, mctx))
        throw exception(sstream() << "clear tactic failed, hypothesis '" << d2->get_pp_name() << "' depends on '" << local_pp_name(H) << "'");
    lctx.clear(*d);
    expr new_mvar              = mctx.mk_metavar_decl(lctx, g->get_type());
    mctx.assign(mvar, new_mvar);
    return new_mvar;
}
Ejemplo n.º 8
0
 /* Collect (and sort) dependencies of collected parameters */
 void collect_and_normalize_dependencies(buffer<expr> & norm_params) {
     name_map<expr> new_types;
     for (unsigned i = 0; i < m_params.size(); i++) {
         expr x = m_params[i];
         expr new_type = collect(m_ctx.instantiate_mvars(m_ctx.infer(x)));
         new_types.insert(mlocal_name(x), new_type);
     }
     local_context const & lctx = m_ctx.lctx();
     std::sort(m_params.begin(), m_params.end(), [&](expr const & l1, expr const & l2) {
             return lctx.get_local_decl(l1)->get_idx() < lctx.get_local_decl(l2)->get_idx();
         });
     for (unsigned i = 0; i < m_params.size(); i++) {
         expr x         = m_params[i];
         expr type      = *new_types.find(mlocal_name(x));
         expr new_type  = replace_locals(type, i, m_params.data(), norm_params.data());
         expr new_param = m_ctx.push_local(local_pp_name(x), new_type, local_info(x));
         norm_params.push_back(new_param);
     }
 }
Ejemplo n.º 9
0
list<list<name>> collect_choice_symbols(expr const & e) {
    buffer<list<name>> r;
    for_each(e, [&](expr const & e, unsigned) {
            if (is_choice(e)) {
                buffer<name> cs;
                for (unsigned i = 0; i < get_num_choices(e); i++) {
                    expr const & c = get_app_fn(get_choice(e, i));
                    if (is_constant(c))
                        cs.push_back(const_name(c));
                    else if (is_local(c))
                        cs.push_back(local_pp_name(c));
                }
                if (cs.size() > 1)
                    r.push_back(to_list(cs));
            }
            return true;
        });
    return to_list(r);
}
Ejemplo n.º 10
0
optional<pair<expr, unsigned>> goal::find_hyp(name const & uname) const {
    return find_hyp_core(m_meta, [&](expr const & h) { return local_pp_name(h) == uname; });
}
Ejemplo n.º 11
0
expr update_local(expr const & e, expr const & new_type, binder_info const & bi) {
    if (is_eqp(mlocal_type(e), new_type) && local_info(e) == bi)
        return e;
    else
        return mk_local(mlocal_name(e), local_pp_name(e), new_type, bi, e.get_tag());
}
Ejemplo n.º 12
0
optional<environment> mk_no_confusion_type(environment const & env, name const & n) {
    optional<inductive::inductive_decls> decls = inductive::is_inductive_decl(env, n);
    if (!decls)
        throw exception(sstream() << "error in 'no_confusion' generation, '" << n << "' is not an inductive datatype");
    if (is_inductive_predicate(env, n))
        return optional<environment>(); // type is a proposition
    name_generator ngen;
    unsigned nparams       = std::get<1>(*decls);
    declaration ind_decl   = env.get(n);
    declaration cases_decl = env.get(name(n, "cases_on"));
    level_param_names lps  = cases_decl.get_univ_params();
    level  rlvl            = mk_param_univ(head(lps));
    levels ilvls           = param_names_to_levels(tail(lps));
    if (length(ilvls) != length(ind_decl.get_univ_params()))
        return optional<environment>(); // type does not have only a restricted eliminator
    expr ind_type          = instantiate_type_univ_params(ind_decl, ilvls);
    name eq_name("eq");
    name heq_name("heq");
    // All inductive datatype parameters and indices are arguments
    buffer<expr> args;
    ind_type = to_telescope(ngen, ind_type, args, some(mk_implicit_binder_info()));
    if (!is_sort(ind_type) || args.size() < nparams)
        throw_corrupted(n);
    lean_assert(!(env.impredicative() && is_zero(sort_level(ind_type))));
    unsigned nindices      = args.size() - nparams;
    // Create inductive datatype
    expr I = mk_app(mk_constant(n, ilvls), args);
    // Add (P : Type)
    expr P = mk_local(ngen.next(), "P", mk_sort(rlvl), binder_info());
    args.push_back(P);
    // add v1 and v2 elements of the inductive type
    expr v1 = mk_local(ngen.next(), "v1", I, binder_info());
    expr v2 = mk_local(ngen.next(), "v2", I, binder_info());
    args.push_back(v1);
    args.push_back(v2);
    expr R  = mk_sort(rlvl);
    name no_confusion_type_name{n, "no_confusion_type"};
    expr no_confusion_type_type = Pi(args, R);
    // Create type former
    buffer<expr> type_former_args;
    for (unsigned i = nparams; i < nparams + nindices; i++)
        type_former_args.push_back(args[i]);
    type_former_args.push_back(v1);
    expr type_former = Fun(type_former_args, R);
    // Create cases_on
    levels clvls   = levels(mk_succ(rlvl), ilvls);
    expr cases_on  = mk_app(mk_app(mk_constant(cases_decl.get_name(), clvls), nparams, args.data()), type_former);
    cases_on       = mk_app(cases_on, nindices, args.data() + nparams);
    expr cases_on1 = mk_app(cases_on, v1);
    expr cases_on2 = mk_app(cases_on, v2);
    type_checker tc(env);
    expr t1        = tc.infer(cases_on1).first;
    expr t2        = tc.infer(cases_on2).first;
    buffer<expr> outer_cases_on_args;
    unsigned idx1 = 0;
    while (is_pi(t1)) {
        buffer<expr> minor1_args;
        expr minor1 = to_telescope(tc, binding_domain(t1), minor1_args);
        expr curr_t2  = t2;
        buffer<expr> inner_cases_on_args;
        unsigned idx2 = 0;
        while (is_pi(curr_t2)) {
            buffer<expr> minor2_args;
            expr minor2 = to_telescope(tc, binding_domain(curr_t2), minor2_args);
            if (idx1 != idx2) {
                // infeasible case, constructors do not match
                inner_cases_on_args.push_back(Fun(minor2_args, P));
            } else {
                if (minor1_args.size() != minor2_args.size())
                    throw_corrupted(n);
                buffer<expr> rtype_hyp;
                // add equalities
                for (unsigned i = 0; i < minor1_args.size(); i++) {
                    expr lhs      = minor1_args[i];
                    expr rhs      = minor2_args[i];
                    expr lhs_type = mlocal_type(lhs);
                    expr rhs_type = mlocal_type(rhs);
                    level l       = sort_level(tc.ensure_type(lhs_type).first);
                    expr h_type;
                    if (tc.is_def_eq(lhs_type, rhs_type).first) {
                        h_type = mk_app(mk_constant(eq_name, to_list(l)), lhs_type, lhs, rhs);
                    } else {
                        h_type = mk_app(mk_constant(heq_name, to_list(l)), lhs_type, lhs, rhs_type, rhs);
                    }
                    rtype_hyp.push_back(mk_local(ngen.next(), local_pp_name(lhs).append_after("_eq"), h_type, binder_info()));
                }
                inner_cases_on_args.push_back(Fun(minor2_args, mk_arrow(Pi(rtype_hyp, P), P)));
            }
            idx2++;
            curr_t2 = binding_body(curr_t2);
        }
        outer_cases_on_args.push_back(Fun(minor1_args, mk_app(cases_on2, inner_cases_on_args)));
        idx1++;
        t1 = binding_body(t1);
    }
    expr no_confusion_type_value = Fun(args, mk_app(cases_on1, outer_cases_on_args));

    bool opaque       = false;
    bool use_conv_opt = true;
    declaration new_d = mk_definition(env, no_confusion_type_name, lps, no_confusion_type_type, no_confusion_type_value,
                                      opaque, ind_decl.get_module_idx(), use_conv_opt);
    environment new_env = module::add(env, check(env, new_d));
    return some(add_protected(new_env, no_confusion_type_name));
}