feat(library/basic_thms): add Refute theorem

Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>

src/frontends/lean/notation.cpp

@@ -111,6 +111,7 @@ void init_builtin_notation(frontend & f) {
     f.mark_implicit_arguments(mk_disj1_fn(), 1);
     f.mark_implicit_arguments(mk_disj2_fn(), 1);
     f.mark_implicit_arguments(mk_disj_cases_fn(), 3);
+    f.mark_implicit_arguments(mk_refute_fn(), 1);
     f.mark_implicit_arguments(mk_symm_fn(), 3);
     f.mark_implicit_arguments(mk_trans_fn(), 4);
     f.mark_implicit_arguments(mk_eqt_elim_fn(), 1);

src/library/basic_thms.cpp

@@ -33,6 +33,7 @@ MK_CONSTANT(conjunct2_fn,       name("Conjunct2"));
 MK_CONSTANT(disj1_fn,           name("Disj1"));
 MK_CONSTANT(disj2_fn,           name("Disj2"));
 MK_CONSTANT(disj_cases_fn,      name("DisjCases"));
+MK_CONSTANT(refute_fn,          name("Refute"));
 MK_CONSTANT(symm_fn,            name("Symm"));
 MK_CONSTANT(trans_fn,           name("Trans"));
 MK_CONSTANT(congr1_fn,          name("Congr1"));
@@ -208,6 +209,11 @@ void import_basic_thms(environment const & env) {
                                                          MT(a, c, Discharge(a, c, H2), H))),
                                                    H))))));
 
+    // Refute : Pi {a : Bool} (H : not a -> false), a */
+    env->add_theorem(refute_fn_name, Pi({{a, Bool}, {H, Not(a) >> False}}, a),
+                     Fun({{a, Bool}, {H, Not(a) >> False}},
+                         DisjCases(a, Not(a), a, EM(a), Fun({H1, a}, H1), Fun({H1, Not(a)}, FalseElim(a, H(H1))))));
+
     // Symm : Pi (A : Type u) (a b : A) (H : a = b), b = a
     env->add_theorem(symm_fn_name, Pi({{A, TypeU}, {a, A}, {b, A}, {H, Eq(a, b)}}, Eq(b, a)),
                      Fun({{A, TypeU}, {a, A}, {b, A}, {H, Eq(a, b)}},

src/library/basic_thms.h

@@ -90,6 +90,10 @@ expr mk_disj_cases_fn();
 /** \brief (Theorem) {a b c : Bool}, H1 : Or(a, b), H2 : a -> c, H3 : b -> c |- DisjCases(a, b, c, H1, H2, H3) : c */
 inline expr DisjCases(expr const & a, expr const & b, expr const & c, expr const & H1, expr const & H2, expr const & H3) { return mk_app({mk_disj_cases_fn(), a, b, c, H1, H2, H3}); }
 
+expr mk_refute_fn();
+/** \brief (Theorem) {a : Bool} (H : not a -> false) |- Refute(a, H) : a */
+inline expr Refute(expr const & a, expr const & H) { return mk_app({mk_refute_fn(), a, H}); }
+
 expr mk_symm_fn();
 /** \brief (Theorem) {A : Type u}, {a b : A}, H : a = b |- Symm(A, a, b, H) : b = a */
 inline expr Symm(expr const & A, expr const & a, expr const & b, expr const & H) { return mk_app(mk_symm_fn(), A, a, b, H); }

tests/lean/refute1.lean

@@ -0,0 +1,3 @@
+Variables a b : Bool
+Axiom H : a /\ b
+Theorem T : a := Refute (fun R, Absurd (Conjunct1 H) R)

tests/lean/refute1.lean.expected.out

@@ -0,0 +1,6 @@
+  Set: pp::colors
+  Set: pp::unicode
+  Assumed: a
+  Assumed: b
+  Assumed: H
+  Proved: T