feat(library/tactic): add 'let' tactic

closes #555

hott/init/tactic.hlean

@@ -96,6 +96,8 @@ opaque definition change (e : expr) : tactic := builtin
 
 opaque definition assert_hypothesis (id : identifier) (e : expr) : tactic := builtin
 
+opaque definition lettac (id : identifier) (e : expr) : tactic := builtin
+
 definition try         (t : tactic) : tactic := or_else t id
 definition repeat1     (t : tactic) : tactic := and_then t (repeat t)
 definition focus       (t : tactic) : tactic := focus_at t 0

library/init/tactic.lean

@@ -96,6 +96,8 @@ opaque definition change (e : expr) : tactic := builtin
 
 opaque definition assert_hypothesis (id : identifier) (e : expr) : tactic := builtin
 
+opaque definition lettac (id : identifier) (e : expr) : tactic := builtin
+
 definition try         (t : tactic) : tactic := or_else t id
 definition repeat1     (t : tactic) : tactic := and_then t (repeat t)
 definition focus       (t : tactic) : tactic := focus_at t 0

src/frontends/lean/builtin_tactics.cpp

@@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE.
 
 Author: Leonardo de Moura
 */
+#include "library/tactic/let_tactic.h"
+#include "frontends/lean/tokens.h"
 #include "frontends/lean/parser.h"
 #include "frontends/lean/parse_rewrite_tactic.h"
 
@@ -29,6 +31,13 @@ static expr parse_rparen(parser &, unsigned, expr const * args, pos_info const &
     return args[0];
 }
 
+static expr parse_let_tactic(parser & p, unsigned, expr const *, pos_info const & pos) {
+    name id    = p.check_atomic_id_next("invalid 'let' tactic, identifier expected");
+    p.check_token_next(get_assign_tk(), "invalid 'let' tactic, ':=' expected");
+    expr value = p.parse_expr();
+    return p.save_pos(mk_let_tactic_expr(id, value), pos);
+}
+
 parse_table init_tactic_nud_table() {
     action Expr(mk_expr_action());
     expr x0 = mk_var(0);
@@ -38,6 +47,7 @@ parse_table init_tactic_nud_table() {
     r = r.add({transition("esimp",   mk_ext_action(parse_esimp_tactic_expr))}, x0);
     r = r.add({transition("unfold",  mk_ext_action(parse_unfold_tactic_expr))}, x0);
     r = r.add({transition("fold",    mk_ext_action(parse_fold_tactic_expr))}, x0);
+    r = r.add({transition("let",    mk_ext_action(parse_let_tactic))}, x0);
     return r;
 }
 

src/library/constants.cpp

@@ -95,6 +95,7 @@ name const * g_tactic_generalize = nullptr;
 name const * g_tactic_generalizes = nullptr;
 name const * g_tactic_id = nullptr;
 name const * g_tactic_interleave = nullptr;
+name const * g_tactic_lettac = nullptr;
 name const * g_tactic_now = nullptr;
 name const * g_tactic_opt_expr_list = nullptr;
 name const * g_tactic_or_else = nullptr;
@@ -213,6 +214,7 @@ void initialize_constants() {
     g_tactic_generalizes = new name{"tactic", "generalizes"};
     g_tactic_id = new name{"tactic", "id"};
     g_tactic_interleave = new name{"tactic", "interleave"};
+    g_tactic_lettac = new name{"tactic", "lettac"};
     g_tactic_now = new name{"tactic", "now"};
     g_tactic_opt_expr_list = new name{"tactic", "opt_expr_list"};
     g_tactic_or_else = new name{"tactic", "or_else"};
@@ -332,6 +334,7 @@ void finalize_constants() {
     delete g_tactic_generalizes;
     delete g_tactic_id;
     delete g_tactic_interleave;
+    delete g_tactic_lettac;
     delete g_tactic_now;
     delete g_tactic_opt_expr_list;
     delete g_tactic_or_else;
@@ -450,6 +453,7 @@ name const & get_tactic_generalize_name() { return *g_tactic_generalize; }
 name const & get_tactic_generalizes_name() { return *g_tactic_generalizes; }
 name const & get_tactic_id_name() { return *g_tactic_id; }
 name const & get_tactic_interleave_name() { return *g_tactic_interleave; }
+name const & get_tactic_lettac_name() { return *g_tactic_lettac; }
 name const & get_tactic_now_name() { return *g_tactic_now; }
 name const & get_tactic_opt_expr_list_name() { return *g_tactic_opt_expr_list; }
 name const & get_tactic_or_else_name() { return *g_tactic_or_else; }

src/library/constants.h

@@ -97,6 +97,7 @@ name const & get_tactic_generalize_name();
 name const & get_tactic_generalizes_name();
 name const & get_tactic_id_name();
 name const & get_tactic_interleave_name();
+name const & get_tactic_lettac_name();
 name const & get_tactic_now_name();
 name const & get_tactic_opt_expr_list_name();
 name const & get_tactic_or_else_name();

src/library/constants.txt

@@ -90,6 +90,7 @@ tactic.generalize
 tactic.generalizes
 tactic.id
 tactic.interleave
+tactic.lettac
 tactic.now
 tactic.opt_expr_list
 tactic.or_else

src/library/tactic/CMakeLists.txt

@@ -4,6 +4,6 @@ exact_tactic.cpp generalize_tactic.cpp
 inversion_tactic.cpp whnf_tactic.cpp revert_tactic.cpp
 assert_tactic.cpp clear_tactic.cpp expr_to_tactic.cpp location.cpp
 rewrite_tactic.cpp util.cpp class_instance_synth.cpp init_module.cpp
-change_tactic.cpp check_expr_tactic.cpp)
+change_tactic.cpp check_expr_tactic.cpp let_tactic.cpp)
 
 target_link_libraries(tactic ${LEAN_LIBS})

src/library/tactic/init_module.cpp

@@ -22,6 +22,7 @@ Author: Leonardo de Moura
 #include "library/tactic/rewrite_tactic.h"
 #include "library/tactic/change_tactic.h"
 #include "library/tactic/check_expr_tactic.h"
+#include "library/tactic/let_tactic.h"
 
 namespace lean {
 void initialize_tactic_module() {
@@ -43,9 +44,11 @@ void initialize_tactic_module() {
     initialize_rewrite_tactic();
     initialize_change_tactic();
     initialize_check_expr_tactic();
+    initialize_let_tactic();
 }
 
 void finalize_tactic_module() {
+    finalize_let_tactic();
     finalize_check_expr_tactic();
     finalize_change_tactic();
     finalize_rewrite_tactic();

src/library/tactic/let_tactic.cpp

@@ -0,0 +1,62 @@
+/*
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+
+Author: Leonardo de Moura
+*/
+#include "kernel/abstract.h"
+#include "library/constants.h"
+#include "library/reducible.h"
+#include "library/tactic/tactic.h"
+#include "library/tactic/elaborate.h"
+#include "library/tactic/expr_to_tactic.h"
+
+namespace lean {
+expr mk_let_tactic_expr(name const & id, expr const & e) {
+    return mk_app(mk_constant(get_tactic_lettac_name()),
+                  mk_constant(id), e);
+}
+
+tactic let_tactic(elaborate_fn const & elab, name const & id, expr const & e) {
+    return tactic01([=](environment const & env, io_state const &, proof_state const & s) {
+            proof_state new_s = s;
+            goals const & gs  = new_s.get_goals();
+            if (!gs) {
+                throw_no_goal_if_enabled(s);
+                return none_proof_state();
+            }
+            goal const & g         = head(gs);
+            name_generator ngen    = s.get_ngen();
+            bool report_unassigned = true;
+            auto ecs = elab(g, ngen.mk_child(), e, none_expr(), report_unassigned);
+            if (ecs.second)
+                throw_tactic_exception_if_enabled(s, "invalid 'let' tactic, fail to resolve generated constraints");
+            expr new_e      = ecs.first;
+            auto tc         = mk_type_checker(env, ngen.mk_child(), s.relax_main_opaque());
+            expr new_e_type = tc->infer(new_e).first;
+            expr new_local  = mk_local(ngen.next(), id, new_e_type, binder_info());
+            buffer<expr> hyps;
+            g.get_hyps(hyps);
+            hyps.push_back(new_local);
+            expr new_mvar  = mk_metavar(ngen.next(), Pi(hyps, g.get_type()));
+            hyps.pop_back();
+            expr new_meta_core = mk_app(new_mvar, hyps);
+            expr new_meta      = mk_app(new_meta_core, new_local);
+            goal new_goal(new_meta, g.get_type());
+            substitution new_subst = new_s.get_subst();
+            assign(new_subst, g, mk_app(new_meta_core, new_e));
+            return some_proof_state(proof_state(s, cons(new_goal, tail(gs)), new_subst, ngen));
+        });
+}
+
+void initialize_let_tactic() {
+    register_tac(get_tactic_lettac_name(),
+                 [](type_checker &, elaborate_fn const & fn, expr const & e, pos_info_provider const *) {
+                     name id = tactic_expr_to_id(app_arg(app_fn(e)), "invalid 'let' tactic, argument must be an identifier");
+                     check_tactic_expr(app_arg(e), "invalid 'let' tactic, argument must be an expression");
+                     return let_tactic(fn, id, get_tactic_expr_expr(app_arg(e)));
+                 });
+}
+void finalize_let_tactic() {
+}
+}

src/library/tactic/let_tactic.h

@@ -0,0 +1,14 @@
+/*
+Copyright (c) 2015 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/expr.h"
+
+namespace lean {
+expr mk_let_tactic_expr(name const & id, expr const & e);
+void initialize_let_tactic();
+void finalize_let_tactic();
+}

tests/lean/interactive/alias.input.expected.out

@@ -6,6 +6,7 @@
 bool.bor_tt|∀ (a : bool), eq (bool.bor a bool.tt) bool.tt
 bool.band_tt|∀ (a : bool), eq (bool.band a bool.tt) a
 bool.tt|bool
+tactic.lettac|tactic.identifier → tactic.expr → tactic
 bool.absurd_of_eq_ff_of_eq_tt|eq ?a bool.ff → eq ?a bool.tt → ?B
 bool.eq_tt_of_ne_ff|ne ?a bool.ff → eq ?a bool.tt
 bool.tt_band|∀ (a : bool), eq (bool.band bool.tt a) a
@@ -22,6 +23,7 @@ tt_bor|∀ (a : bool), eq (bor tt a) tt
 tt_band|∀ (a : bool), eq (band tt a) a
 bor_tt|∀ (a : bool), eq (bor a tt) tt
 band_tt|∀ (a : bool), eq (band a tt) a
+tactic.lettac|tactic.identifier → tactic.expr → tactic
 absurd_of_eq_ff_of_eq_tt|eq ?a ff → eq ?a tt → ?B
 eq_tt_of_ne_ff|ne ?a ff → eq ?a tt
 cond_tt|∀ (t e : ?A), eq (cond tt t e) t

tests/lean/run/let_tac.lean

@@ -0,0 +1,18 @@
+import data.nat
+
+example (a b : Prop) : a → b → a ∧ b :=
+begin
+  intro Ha, intro Hb,
+  let aux := and.intro Ha Hb,
+  exact aux
+end
+
+open nat
+
+example (a b : nat) : a > 0 → b > 0 → a + b + 0 > 0 :=
+begin
+  intro agt0, intro bgt0,
+  let H := add_pos agt0 bgt0,
+  change a + b > 0,
+  exact H
+end