diff --git a/src/frontends/lean/CMakeLists.txt b/src/frontends/lean/CMakeLists.txt index f5a518bc7..503c0528c 100644 --- a/src/frontends/lean/CMakeLists.txt +++ b/src/frontends/lean/CMakeLists.txt @@ -3,6 +3,6 @@ scanner.cpp parse_table.cpp parser_config.cpp parser.cpp parser_pos_provider.cpp builtin_cmds.cpp builtin_exprs.cpp interactive.cpp notation_cmd.cpp calc.cpp decl_cmds.cpp util.cpp inductive_cmd.cpp elaborator.cpp -dependencies.cpp parser_bindings.cpp) +dependencies.cpp parser_bindings.cpp proof_qed_ext.cpp) target_link_libraries(lean_frontend ${LEAN_LIBS}) diff --git a/src/frontends/lean/builtin_cmds.cpp b/src/frontends/lean/builtin_cmds.cpp index 4baa7614d..4802e055b 100644 --- a/src/frontends/lean/builtin_cmds.cpp +++ b/src/frontends/lean/builtin_cmds.cpp @@ -19,6 +19,7 @@ Author: Leonardo de Moura #include "frontends/lean/calc.h" #include "frontends/lean/notation_cmd.h" #include "frontends/lean/inductive_cmd.h" +#include "frontends/lean/proof_qed_ext.h" #include "frontends/lean/decl_cmds.h" namespace lean { @@ -246,6 +247,7 @@ cmd_table init_cmd_table() { register_inductive_cmd(r); register_notation_cmds(r); register_calc_cmds(r); + register_proof_qed_cmds(r); return r; } diff --git a/src/frontends/lean/builtin_exprs.cpp b/src/frontends/lean/builtin_exprs.cpp index 827c7dca7..679466672 100644 --- a/src/frontends/lean/builtin_exprs.cpp +++ b/src/frontends/lean/builtin_exprs.cpp @@ -12,6 +12,7 @@ Author: Leonardo de Moura #include "frontends/lean/builtin_exprs.h" #include "frontends/lean/token_table.h" #include "frontends/lean/calc.h" +#include "frontends/lean/proof_qed_ext.h" #include "frontends/lean/parser.h" namespace lean { @@ -131,13 +132,8 @@ static expr parse_by(parser & p, unsigned, expr const *, pos_info const & pos) { return p.save_pos(mk_by(t), pos); } -static optional get_proof_qed_pre_tac(environment const & /* env */) { - // TODO(Leo) - return none_expr(); -} - static expr parse_proof_qed(parser & p, unsigned, expr const *, pos_info const &) { - optional pre_tac = get_proof_qed_pre_tac(p.env()); + optional pre_tac = get_proof_qed_pre_tactic(p.env()); optional r; while (true) { bool use_exact = (p.curr_is_token(g_have) || p.curr_is_token(g_show) || p.curr_is_token(g_assume) || diff --git a/src/frontends/lean/elaborator.cpp b/src/frontends/lean/elaborator.cpp index fdce77793..23038c087 100644 --- a/src/frontends/lean/elaborator.cpp +++ b/src/frontends/lean/elaborator.cpp @@ -645,7 +645,7 @@ public: void check_exact_tacs(expr const & pre_tac, substitution const & s) { for_each(pre_tac, [&](expr const & e, unsigned) { expr const & f = get_app_fn(e); - if (is_constant(f) && const_name(f) == get_exact_tac_name()) { + if (is_constant(f) && const_name(f) == const_name(get_exact_tac_fn())) { display_unassigned_mvars(e, s); return false; } else { diff --git a/src/frontends/lean/proof_qed_ext.cpp b/src/frontends/lean/proof_qed_ext.cpp new file mode 100644 index 000000000..48c9ca877 --- /dev/null +++ b/src/frontends/lean/proof_qed_ext.cpp @@ -0,0 +1,107 @@ +/* +Copyright (c) 2014 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. + +Author: Leonardo de Moura +*/ +#include +#include "kernel/type_checker.h" +#include "library/scoped_ext.h" +#include "library/kernel_serializer.h" +#include "library/tactic/expr_to_tactic.h" +#include "frontends/lean/parser.h" + +namespace lean { +// This (scoped) environment extension allows us to set a tactic to be applied before every element +// in a proof ... qed block +struct pq_entry { + bool m_accumulate; // if true, then accumulate the new tactic, if false replace + expr m_tac; + pq_entry():m_accumulate(false) {} + pq_entry(bool a, expr const & t):m_accumulate(a), m_tac(t) {} +}; + +struct pq_state { + optional m_pre_tac; + optional m_pre_tac_body; +}; + +struct pq_config { + typedef pq_state state; + typedef pq_entry entry; + static void add_entry(environment const &, io_state const &, state & s, entry const & e) { + if (e.m_accumulate) { + if (s.m_pre_tac_body) + s.m_pre_tac_body = mk_app(get_or_else_tac_fn(), *s.m_pre_tac_body, e.m_tac); + else + s.m_pre_tac_body = e.m_tac; + s.m_pre_tac = mk_app(get_repeat_tac_fn(), *s.m_pre_tac_body); + } else { + // reset + s.m_pre_tac = e.m_tac; + s.m_pre_tac_body = e.m_tac; + } + } + static name const & get_class_name() { + static name g_class_name("proof_qed"); + return g_class_name; + } + static std::string const & get_serialization_key() { + static std::string g_key("pq_pre_tac"); + return g_key; + } + static void write_entry(serializer & s, entry const & e) { + s << e.m_accumulate << e.m_tac; + } + static entry read_entry(deserializer & d) { + entry e; + d >> e.m_accumulate >> e.m_tac; + return e; + } +}; + +template class scoped_ext; +typedef scoped_ext proof_qed_ext; + +static void check_valid_tactic(environment const & env, expr const & pre_tac) { + type_checker tc(env); + if (!tc.is_def_eq(tc.infer(pre_tac), get_tactic_type())) + throw exception("invalid proof-qed pre-tactic update, argument is not a tactic"); +} + +environment add_proof_qed_pre_tactic(environment const & env, expr const & pre_tac) { + check_valid_tactic(env, pre_tac); + return proof_qed_ext::add_entry(env, get_dummy_ios(), pq_entry(true, pre_tac)); +} + +environment reset_proof_qed_pre_tactic(environment const & env, expr const & pre_tac) { + check_valid_tactic(env, pre_tac); + return proof_qed_ext::add_entry(env, get_dummy_ios(), pq_entry(false, pre_tac)); +} + +optional get_proof_qed_pre_tactic(environment const & env) { + pq_state const & s = proof_qed_ext::get_state(env); + return s.m_pre_tac; +} + +static expr parse_tactic_name(parser & p) { + auto pos = p.pos(); + name id = p.check_id_next("invalid proof_qed configuration command, indentifier expected"); + return p.id_to_expr(id, pos); +} + +environment add_proof_qed_cmd(parser & p) { + return add_proof_qed_pre_tactic(p.env(), parse_tactic_name(p)); +} + +environment reset_proof_qed_cmd(parser & p) { + return reset_proof_qed_pre_tactic(p.env(), parse_tactic_name(p)); +} + +void register_proof_qed_cmds(cmd_table & r) { + add_cmd(r, cmd_info("add_proof_qed", "add a new tactic to be automatically applied before every component in a 'proof-qed' block", + add_proof_qed_cmd)); + add_cmd(r, cmd_info("reset_proof_qed", "reset the tactic that is automatically applied before every component in a 'proof-qed' block", + reset_proof_qed_cmd)); +} +} diff --git a/src/frontends/lean/proof_qed_ext.h b/src/frontends/lean/proof_qed_ext.h new file mode 100644 index 000000000..4e4e6e88a --- /dev/null +++ b/src/frontends/lean/proof_qed_ext.h @@ -0,0 +1,16 @@ +/* +Copyright (c) 2014 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. + +Author: Leonardo de Moura +*/ +#pragma once +#include "kernel/environment.h" +#include "frontends/lean/cmd_table.h" + +namespace lean { +environment add_proof_qed_pre_tactic(environment const & env, expr const & pre_tac); +environment reset_proof_qed_pre_tactic(environment const & env, expr const & pre_tac); +optional get_proof_qed_pre_tactic(environment const & env); +void register_proof_qed_cmds(cmd_table & r); +} diff --git a/src/frontends/lean/token_table.cpp b/src/frontends/lean/token_table.cpp index e32adf429..3a2931e3f 100644 --- a/src/frontends/lean/token_table.cpp +++ b/src/frontends/lean/token_table.cpp @@ -67,7 +67,8 @@ token_table init_token_table() { "evaluate", "check", "print", "end", "namespace", "section", "import", "abbreviation", "inductive", "record", "structure", "module", "universe", "precedence", "infixl", "infixr", "infix", "postfix", "notation", "exit", "set_option", - "using", "calc_subst", "calc_refl", "calc_trans", "#setline", nullptr}; + "using", "calc_subst", "calc_refl", "calc_trans", "add_proof_qed", "reset_proof_qed", + "#setline", nullptr}; std::pair aliases[] = {{g_lambda_unicode, "fun"}, {"forall", "Pi"}, {g_forall_unicode, "Pi"}, {g_pi_unicode, "Pi"}, diff --git a/src/kernel/type_checker.cpp b/src/kernel/type_checker.cpp index 92f3d6a4f..4f7ac28d0 100644 --- a/src/kernel/type_checker.cpp +++ b/src/kernel/type_checker.cpp @@ -430,7 +430,7 @@ static void check_no_local(environment const & env, expr const & e) { throw_kernel_exception(env, "failed to add declaration to environment, it contains local constants", e); } -static void check_no_mlocal(environment const & env, name const & n, expr const & e, bool is_type) { +void check_no_mlocal(environment const & env, name const & n, expr const & e, bool is_type) { check_no_metavar(env, n, e, is_type); check_no_local(env, e); } diff --git a/src/library/tactic/expr_to_tactic.cpp b/src/library/tactic/expr_to_tactic.cpp index 514a719b0..41d5a5584 100644 --- a/src/library/tactic/expr_to_tactic.cpp +++ b/src/library/tactic/expr_to_tactic.cpp @@ -24,7 +24,7 @@ void register_expr_to_tactic(name const & n, expr_to_tactic_fn const & fn) { } tactic expr_to_tactic(type_checker & tc, expr const & e, pos_info_provider const * p) { - expr const & f = get_app_fn(tc.whnf(e)); + expr f = get_app_fn(tc.whnf(e)); if (is_constant(f)) { auto const & map = get_expr_to_tactic_map(); auto it = map.find(const_name(f)); @@ -80,23 +80,25 @@ register_unary_tac::register_unary_tac(name const & n, std::functionget_file_name()), p->get_pos_info(e)); diff --git a/src/library/tactic/expr_to_tactic.h b/src/library/tactic/expr_to_tactic.h index 60a4736a2..ef62ead9e 100644 --- a/src/library/tactic/expr_to_tactic.h +++ b/src/library/tactic/expr_to_tactic.h @@ -28,10 +28,11 @@ struct register_unary_tac { register_unary_tac(name const & n, std::function f); }; -name const & get_exact_tac_name(); -name const & get_and_then_tac_name(); +expr const & get_tactic_type(); expr const & get_exact_tac_fn(); expr const & get_and_then_tac_fn(); +expr const & get_or_else_tac_fn(); +expr const & get_repeat_tac_fn(); tactic expr_to_tactic(environment const & env, expr const & e, pos_info_provider const *p); expr mk_by(expr const & e); diff --git a/tests/lean/run/tactic14.lean b/tests/lean/run/tactic14.lean new file mode 100644 index 000000000..cc1197e98 --- /dev/null +++ b/tests/lean/run/tactic14.lean @@ -0,0 +1,14 @@ +import standard +using tactic + +definition basic_tac : tactic +:= repeat (apply @and_intro | apply @not_intro | assumption) + +reset_proof_qed basic_tac -- basic_tac is automatically applied to each element of a proof-qed block + +theorem tst (a b : Bool) (H : ¬ a ∨ ¬ b) (Hb : b) : ¬ a ∧ b := +proof + assume Ha, or_elim H + (assume Hna, absurd Ha Hna) + (assume Hnb, absurd Hb Hnb) +qed \ No newline at end of file