-
Notifications
You must be signed in to change notification settings - Fork 49
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Experiment for a MathComp lra tactic
This is simple and already works but has major limitations: - only works for R (from Coq stdlib) - pulls axioms from real numbers in Coq stdlib every time it's used We may like this to work for any realFieldType, maybe we should write a new MathComp frontend to the lra.
- Loading branch information
Showing
1 changed file
with
73 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,73 @@ | ||
Require Import Rdefinitions Raxioms RIneq. | ||
Require Import Lra. | ||
From mathcomp Require Import ssreflect ssrbool eqtype ssralg ssrint ssrnum. | ||
Require Import Rstruct. | ||
|
||
Delimit Scope R_scope with Re. | ||
|
||
Local Open Scope ring_scope. | ||
|
||
(* Adapted from http://github.com/pi8027/formalized-postscript/blob/master/stdlib_ext.v *) | ||
|
||
Ltac mclra_hyps2R := | ||
match goal with | ||
| H : context [andb _ _] |- _ => let H0 := fresh in case/andP: H => H H0 | ||
| H : context [orb _ _] |- _ => case/orP: H => H | ||
| H : context [?L <= ?R] |- _ => move/RleP: H => H | ||
| H : context [?L < ?R] |- _ => move/RltP : H => H | ||
| H : context [?L == ?R] |- _ => move/eqP : H => H | ||
| H : context [?L + ?R] |- _ => rewrite -RplusE in H | ||
| H : context [?L * ?R] |- _ => rewrite -RmultE in H | ||
| H : context [?L - ?R] |- _ => rewrite -RminusE in H | ||
| H : context [- ?R] |- _ => rewrite -RoppE in H | ||
| H : context [?x%:R] |- _ => | ||
rewrite -INRE INR_IZR_INZ [IZR (Z.of_nat _)]/= in H | ||
| H : context [?x%:~R] |- _ => | ||
rewrite -pmulrn -INRE INR_IZR_INZ [IZR (Z.of_nat _)]/= in H | ||
end. | ||
|
||
Ltac mclra_goal2R := | ||
match goal with | ||
| |- is_true (andb _ _) => apply/andP; split | ||
| |- is_true (orb _ _) => try apply/orP | ||
| |- is_true (_ <= _) => try apply/RleP | ||
| |- is_true (_ < _) => try apply/RltP | ||
| |- is_true (_ == _) => try apply/eqP | ||
| |- context [?L + ?R] => rewrite -RplusE | ||
| |- context [?L * ?R] => rewrite -RmultE | ||
| |- context [?L - ?R] => rewrite -RminusE | ||
| |- context [- ?R] => rewrite -RoppE | ||
| |- context [?x%:R] => rewrite -INRE INR_IZR_INZ [IZR (Z.of_nat _)]/= | ||
| |- context [?x%:~R] => | ||
rewrite -pmulrn -INRE INR_IZR_INZ [IZR (Z.of_nat _)]/= | ||
end. | ||
|
||
Ltac mclra := repeat mclra_hyps2R; repeat mclra_goal2R; lra. | ||
|
||
(* A few tests/examples *) | ||
|
||
Goal forall x y : R, | ||
x + 2%:R * y <= 3%:R -> 2%:R * x + y <= 3%:R -> x + y <= 2%:R. | ||
Proof. | ||
move=> x y lineq_xy lineq'_xy. | ||
mclra. | ||
Qed. | ||
|
||
Goal forall x y : R, | ||
x + 2%:R * y <= 3%:R -> 2%:R * x + y <= 3%:R -> x + y > 2%:R -> False. | ||
Proof. | ||
move=> x y lineq_xy lineq_xy' lineq_xy''. | ||
mclra. | ||
Qed. | ||
|
||
Goal forall x : R, x <= -11%:~R -> x <= 12%:R. | ||
Proof. | ||
move=> x lineq_xy. | ||
mclra. | ||
Qed. | ||
|
||
Goal forall (n : int) (x : R), x <= n%:~R -> x + x <= n%:~R + n%:~R. | ||
Proof. | ||
move=> n x lineq_xy. | ||
mclra. | ||
Qed. |