diff options
| author | Emilio Jesus Gallego Arias | 2020-02-05 17:46:07 +0100 |
|---|---|---|
| committer | Emilio Jesus Gallego Arias | 2020-02-13 21:12:03 +0100 |
| commit | 9193769161e1f06b371eed99dfe9e90fec9a14a6 (patch) | |
| tree | e16e5f60ce6a88656ccd802d232cde6171be927d /plugins/rtauto | |
| parent | eb83c142eb33de18e3bfdd7c32ecfb797a640c38 (diff) | |
[build] Consolidate stdlib's .v files under a single directory.
Currently, `.v` under the `Coq.` prefix are found in both `theories`
and `plugins`. Usually these two directories are merged by special
loadpath code that allows double-binding of the prefix.
This adds some complexity to the build and loadpath system; and in
particular, it prevents from handling the `Coq.*` prefix in the
simple, `-R theories Coq` standard way.
We thus move all `.v` files to theories, leaving `plugins` as an
OCaml-only directory, and modify accordingly the loadpath / build
infrastructure.
Note that in general `plugins/foo/Foo.v` was not self-contained, in
the sense that it depended on files in `theories` and files in
`theories` depended on it; moreover, Coq saw all these files as
belonging to the same namespace so it didn't really care where they
lived.
This could also imply a performance gain as we now effectively
traverse less directories when locating a library.
See also discussion in #10003
Diffstat (limited to 'plugins/rtauto')
| -rw-r--r-- | plugins/rtauto/Bintree.v | 385 | ||||
| -rw-r--r-- | plugins/rtauto/Rtauto.v | 410 |
2 files changed, 0 insertions, 795 deletions
diff --git a/plugins/rtauto/Bintree.v b/plugins/rtauto/Bintree.v deleted file mode 100644 index 6b92445326..0000000000 --- a/plugins/rtauto/Bintree.v +++ /dev/null @@ -1,385 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) -(* <O___,, * (see CREDITS file for the list of authors) *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(* * (see LICENSE file for the text of the license) *) -(************************************************************************) - -Require Export List. -Require Export BinPos. -Require Arith.EqNat. - -Open Scope positive_scope. - -Ltac clean := try (simpl; congruence). - -Lemma Gt_Psucc: forall p q, - (p ?= Pos.succ q) = Gt -> (p ?= q) = Gt. -Proof. -intros. rewrite <- Pos.compare_succ_succ. -now apply Pos.lt_gt, Pos.lt_lt_succ, Pos.gt_lt. -Qed. - -Lemma Psucc_Gt : forall p, - (Pos.succ p ?= p) = Gt. -Proof. -intros. apply Pos.lt_gt, Pos.lt_succ_diag_r. -Qed. - -Fixpoint Lget (A:Set) (n:nat) (l:list A) {struct l}:option A := -match l with nil => None -| x::q => -match n with O => Some x -| S m => Lget A m q -end end . - -Arguments Lget [A] n l. - -Lemma map_app : forall (A B:Set) (f:A -> B) l m, -List.map f (l ++ m) = List.map f l ++ List.map f m. -induction l. -reflexivity. -simpl. -intro m ; apply f_equal;apply IHl. -Qed. - -Lemma length_map : forall (A B:Set) (f:A -> B) l, -length (List.map f l) = length l. -induction l. -reflexivity. -simpl; apply f_equal;apply IHl. -Qed. - -Lemma Lget_map : forall (A B:Set) (f:A -> B) i l, -Lget i (List.map f l) = -match Lget i l with Some a => -Some (f a) | None => None end. -induction i;intros [ | x l ] ;trivial. -simpl;auto. -Qed. - -Lemma Lget_app : forall (A:Set) (a:A) l i, -Lget i (l ++ a :: nil) = if Arith.EqNat.beq_nat i (length l) then Some a else Lget i l. -Proof. -induction l;simpl Lget;simpl length. -intros [ | i];simpl;reflexivity. -intros [ | i];simpl. -reflexivity. -auto. -Qed. - -Lemma Lget_app_Some : forall (A:Set) l delta i (a: A), -Lget i l = Some a -> -Lget i (l ++ delta) = Some a. -induction l;destruct i;simpl;try congruence;auto. -Qed. - -Inductive Poption {A} : Type:= - PSome : A -> Poption -| PNone : Poption. -Arguments Poption : clear implicits. - -Inductive Tree {A} : Type := - Tempty : Tree - | Branch0 : Tree -> Tree -> Tree - | Branch1 : A -> Tree -> Tree -> Tree. -Arguments Tree : clear implicits. - -Section Store. - -Variable A:Type. - -Notation Poption := (Poption A). -Notation Tree := (Tree A). - - -Fixpoint Tget (p:positive) (T:Tree) {struct p} : Poption := - match T with - Tempty => PNone - | Branch0 T1 T2 => - match p with - xI pp => Tget pp T2 - | xO pp => Tget pp T1 - | xH => PNone - end - | Branch1 a T1 T2 => - match p with - xI pp => Tget pp T2 - | xO pp => Tget pp T1 - | xH => PSome a - end -end. - -Fixpoint Tadd (p:positive) (a:A) (T:Tree) {struct p}: Tree := - match T with - | Tempty => - match p with - | xI pp => Branch0 Tempty (Tadd pp a Tempty) - | xO pp => Branch0 (Tadd pp a Tempty) Tempty - | xH => Branch1 a Tempty Tempty - end - | Branch0 T1 T2 => - match p with - | xI pp => Branch0 T1 (Tadd pp a T2) - | xO pp => Branch0 (Tadd pp a T1) T2 - | xH => Branch1 a T1 T2 - end - | Branch1 b T1 T2 => - match p with - | xI pp => Branch1 b T1 (Tadd pp a T2) - | xO pp => Branch1 b (Tadd pp a T1) T2 - | xH => Branch1 a T1 T2 - end - end. - -Definition mkBranch0 (T1 T2:Tree) := - match T1,T2 with - Tempty ,Tempty => Tempty - | _,_ => Branch0 T1 T2 - end. - -Fixpoint Tremove (p:positive) (T:Tree) {struct p}: Tree := - match T with - | Tempty => Tempty - | Branch0 T1 T2 => - match p with - | xI pp => mkBranch0 T1 (Tremove pp T2) - | xO pp => mkBranch0 (Tremove pp T1) T2 - | xH => T - end - | Branch1 b T1 T2 => - match p with - | xI pp => Branch1 b T1 (Tremove pp T2) - | xO pp => Branch1 b (Tremove pp T1) T2 - | xH => mkBranch0 T1 T2 - end - end. - - -Theorem Tget_Tempty: forall (p : positive), Tget p (Tempty) = PNone. -destruct p;reflexivity. -Qed. - -Theorem Tget_Tadd: forall i j a T, - Tget i (Tadd j a T) = - match (i ?= j) with - Eq => PSome a - | Lt => Tget i T - | Gt => Tget i T - end. -Proof. -intros i j. -case_eq (i ?= j). -intro H;rewrite (Pos.compare_eq _ _ H);intros a;clear i H. -induction j;destruct T;simpl;try (apply IHj);congruence. -unfold Pos.compare. -generalize i;clear i;induction j;destruct T;simpl in H|-*; -destruct i;simpl;try rewrite (IHj _ H);try (destruct i;simpl;congruence);reflexivity|| congruence. -unfold Pos.compare. -generalize i;clear i;induction j;destruct T;simpl in H|-*; -destruct i;simpl;try rewrite (IHj _ H);try (destruct i;simpl;congruence);reflexivity|| congruence. -Qed. - -Record Store : Type := -mkStore {index:positive;contents:Tree}. - -Definition empty := mkStore xH Tempty. - -Definition push a S := -mkStore (Pos.succ (index S)) (Tadd (index S) a (contents S)). - -Definition get i S := Tget i (contents S). - -Lemma get_empty : forall i, get i empty = PNone. -intro i; case i; unfold empty,get; simpl;reflexivity. -Qed. - -Inductive Full : Store -> Type:= - F_empty : Full empty - | F_push : forall a S, Full S -> Full (push a S). - -Theorem get_Full_Gt : forall S, Full S -> - forall i, (i ?= index S) = Gt -> get i S = PNone. -Proof. -intros S W;induction W. -unfold empty,index,get,contents;intros;apply Tget_Tempty. -unfold index,get,push. simpl @contents. -intros i e;rewrite Tget_Tadd. -rewrite (Gt_Psucc _ _ e). -unfold get in IHW. -apply IHW;apply Gt_Psucc;assumption. -Qed. - -Theorem get_Full_Eq : forall S, Full S -> get (index S) S = PNone. -intros [index0 contents0] F. -case F. -unfold empty,index,get,contents;intros;apply Tget_Tempty. -unfold push,index,get;simpl @contents. -intros a S. -rewrite Tget_Tadd. -rewrite Psucc_Gt. -intro W. -change (get (Pos.succ (index S)) S =PNone). -apply get_Full_Gt; auto. -apply Psucc_Gt. -Qed. - -Theorem get_push_Full : - forall i a S, Full S -> - get i (push a S) = - match (i ?= index S) with - Eq => PSome a - | Lt => get i S - | Gt => PNone -end. -Proof. -intros i a S F. -case_eq (i ?= index S). -intro e;rewrite (Pos.compare_eq _ _ e). -destruct S;unfold get,push,index;simpl @contents;rewrite Tget_Tadd. -rewrite Pos.compare_refl;reflexivity. -intros;destruct S;unfold get,push,index;simpl @contents;rewrite Tget_Tadd. -simpl @index in H;rewrite H;reflexivity. -intro H;generalize H;clear H. -unfold get,push;simpl. -rewrite Tget_Tadd;intro e;rewrite e. -change (get i S=PNone). -apply get_Full_Gt;auto. -Qed. - -Lemma Full_push_compat : forall i a S, Full S -> -forall x, get i S = PSome x -> - get i (push a S) = PSome x. -Proof. -intros i a S F x H. -case_eq (i ?= index S);intro test. -rewrite (Pos.compare_eq _ _ test) in H. -rewrite (get_Full_Eq _ F) in H;congruence. -rewrite <- H. -rewrite (get_push_Full i a). -rewrite test;reflexivity. -assumption. -rewrite (get_Full_Gt _ F) in H;congruence. -Qed. - -Lemma Full_index_one_empty : forall S, Full S -> index S = 1 -> S=empty. -intros [ind cont] F one; inversion F. -reflexivity. -simpl @index in one;assert (h:=Pos.succ_not_1 (index S)). -congruence. -Qed. - -Lemma push_not_empty: forall a S, (push a S) <> empty. -intros a [ind cont];unfold push,empty. -intros [= H%Pos.succ_not_1]. assumption. -Qed. - -Fixpoint In (x:A) (S:Store) (F:Full S) {struct F}: Prop := -match F with -F_empty => False -| F_push a SS FF => x=a \/ In x SS FF -end. - -Lemma get_In : forall (x:A) (S:Store) (F:Full S) i , -get i S = PSome x -> In x S F. -induction F. -intro i;rewrite get_empty; congruence. -intro i;rewrite get_push_Full;trivial. -case_eq (i ?= index S);simpl. -left;congruence. -right;eauto. -congruence. -Qed. - -End Store. - -Arguments PNone {A}. -Arguments PSome [A] _. - -Arguments Tempty {A}. -Arguments Branch0 [A] _ _. -Arguments Branch1 [A] _ _ _. - -Arguments Tget [A] p T. -Arguments Tadd [A] p a T. - -Arguments Tget_Tempty [A] p. -Arguments Tget_Tadd [A] i j a T. - -Arguments mkStore [A] index contents. -Arguments index [A] s. -Arguments contents [A] s. - -Arguments empty {A}. -Arguments get [A] i S. -Arguments push [A] a S. - -Arguments get_empty [A] i. -Arguments get_push_Full [A] i a S _. - -Arguments Full [A] _. -Arguments F_empty {A}. -Arguments F_push [A] a S _. -Arguments In [A] x S F. - -Register empty as plugins.rtauto.empty. -Register push as plugins.rtauto.push. - -Section Map. - -Variables A B:Set. - -Variable f: A -> B. - -Fixpoint Tmap (T: Tree A) : Tree B := -match T with -Tempty => Tempty -| Branch0 t1 t2 => Branch0 (Tmap t1) (Tmap t2) -| Branch1 a t1 t2 => Branch1 (f a) (Tmap t1) (Tmap t2) -end. - -Lemma Tget_Tmap: forall T i, -Tget i (Tmap T)= match Tget i T with PNone => PNone -| PSome a => PSome (f a) end. -induction T;intro i;case i;simpl;auto. -Defined. - -Lemma Tmap_Tadd: forall i a T, -Tmap (Tadd i a T) = Tadd i (f a) (Tmap T). -induction i;intros a T;case T;simpl;intros;try (rewrite IHi);simpl;reflexivity. -Defined. - -Definition map (S:Store A) : Store B := -mkStore (index S) (Tmap (contents S)). - -Lemma get_map: forall i S, -get i (map S)= match get i S with PNone => PNone -| PSome a => PSome (f a) end. -destruct S;unfold get,map,contents,index;apply Tget_Tmap. -Defined. - -Lemma map_push: forall a S, -map (push a S) = push (f a) (map S). -intros a S. -case S. -unfold push,map,contents,index. -intros;rewrite Tmap_Tadd;reflexivity. -Defined. - -Theorem Full_map : forall S, Full S -> Full (map S). -intros S F. -induction F. -exact F_empty. -rewrite map_push;constructor 2;assumption. -Defined. - -End Map. - -Arguments Tmap [A B] f T. -Arguments map [A B] f S. -Arguments Full_map [A B f] S _. - -Notation "hyps \ A" := (push A hyps) (at level 72,left associativity). diff --git a/plugins/rtauto/Rtauto.v b/plugins/rtauto/Rtauto.v deleted file mode 100644 index 2e9b4347b9..0000000000 --- a/plugins/rtauto/Rtauto.v +++ /dev/null @@ -1,410 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) -(* <O___,, * (see CREDITS file for the list of authors) *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(* * (see LICENSE file for the text of the license) *) -(************************************************************************) - - -Require Export List. -Require Export Bintree. -Require Import Bool BinPos. - -Declare ML Module "rtauto_plugin". - -Ltac clean:=try (simpl;congruence). - -Inductive form:Set:= - Atom : positive -> form -| Arrow : form -> form -> form -| Bot -| Conjunct : form -> form -> form -| Disjunct : form -> form -> form. - -Notation "[ n ]":=(Atom n). -Notation "A =>> B":= (Arrow A B) (at level 59, right associativity). -Notation "#" := Bot. -Notation "A //\\ B" := (Conjunct A B) (at level 57, left associativity). -Notation "A \\// B" := (Disjunct A B) (at level 58, left associativity). - -Definition ctx := Store form. - -Fixpoint pos_eq (m n:positive) {struct m} :bool := -match m with - xI mm => match n with xI nn => pos_eq mm nn | _ => false end -| xO mm => match n with xO nn => pos_eq mm nn | _ => false end -| xH => match n with xH => true | _ => false end -end. - -Theorem pos_eq_refl : forall m n, pos_eq m n = true -> m = n. -induction m;simpl;destruct n;congruence || -(intro e;apply f_equal;auto). -Qed. - -Fixpoint form_eq (p q:form) {struct p} :bool := -match p with - Atom m => match q with Atom n => pos_eq m n | _ => false end -| Arrow p1 p2 => -match q with - Arrow q1 q2 => form_eq p1 q1 && form_eq p2 q2 -| _ => false end -| Bot => match q with Bot => true | _ => false end -| Conjunct p1 p2 => -match q with - Conjunct q1 q2 => form_eq p1 q1 && form_eq p2 q2 -| _ => false -end -| Disjunct p1 p2 => -match q with - Disjunct q1 q2 => form_eq p1 q1 && form_eq p2 q2 -| _ => false -end -end. - -Theorem form_eq_refl: forall p q, form_eq p q = true -> p = q. -induction p;destruct q;simpl;clean. -intro h;generalize (pos_eq_refl _ _ h);congruence. -case_eq (form_eq p1 q1);clean. -intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence. -case_eq (form_eq p1 q1);clean. -intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence. -case_eq (form_eq p1 q1);clean. -intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence. -Qed. - -Arguments form_eq_refl [p q] _. - -Section with_env. - -Variable env:Store Prop. - -Fixpoint interp_form (f:form): Prop := -match f with -[n]=> match get n env with PNone => True | PSome P => P end -| A =>> B => (interp_form A) -> (interp_form B) -| # => False -| A //\\ B => (interp_form A) /\ (interp_form B) -| A \\// B => (interp_form A) \/ (interp_form B) -end. - -Notation "[[ A ]]" := (interp_form A). - -Fixpoint interp_ctx (hyps:ctx) (F:Full hyps) (G:Prop) {struct F} : Prop := -match F with - F_empty => G -| F_push H hyps0 F0 => interp_ctx hyps0 F0 ([[H]] -> G) -end. - -Ltac wipe := intros;simpl;constructor. - -Lemma compose0 : -forall hyps F (A:Prop), - A -> - (interp_ctx hyps F A). -induction F;intros A H;simpl;auto. -Qed. - -Lemma compose1 : -forall hyps F (A B:Prop), - (A -> B) -> - (interp_ctx hyps F A) -> - (interp_ctx hyps F B). -induction F;intros A B H;simpl;auto. -apply IHF;auto. -Qed. - -Theorem compose2 : -forall hyps F (A B C:Prop), - (A -> B -> C) -> - (interp_ctx hyps F A) -> - (interp_ctx hyps F B) -> - (interp_ctx hyps F C). -induction F;intros A B C H;simpl;auto. -apply IHF;auto. -Qed. - -Theorem compose3 : -forall hyps F (A B C D:Prop), - (A -> B -> C -> D) -> - (interp_ctx hyps F A) -> - (interp_ctx hyps F B) -> - (interp_ctx hyps F C) -> - (interp_ctx hyps F D). -induction F;intros A B C D H;simpl;auto. -apply IHF;auto. -Qed. - -Lemma weaken : forall hyps F f G, - (interp_ctx hyps F G) -> - (interp_ctx (hyps\f) (F_push f hyps F) G). -induction F;simpl;intros;auto. -apply compose1 with ([[a]]-> G);auto. -Qed. - -Theorem project_In : forall hyps F g, -In g hyps F -> -interp_ctx hyps F [[g]]. -induction F;simpl. -contradiction. -intros g H;destruct H. -subst;apply compose0;simpl;trivial. -apply compose1 with [[g]];auto. -Qed. - -Theorem project : forall hyps F p g, -get p hyps = PSome g-> -interp_ctx hyps F [[g]]. -intros hyps F p g e; apply project_In. -apply get_In with p;assumption. -Qed. - -Arguments project [hyps] F [p g] _. - -Inductive proof:Set := - Ax : positive -> proof -| I_Arrow : proof -> proof -| E_Arrow : positive -> positive -> proof -> proof -| D_Arrow : positive -> proof -> proof -> proof -| E_False : positive -> proof -| I_And: proof -> proof -> proof -| E_And: positive -> proof -> proof -| D_And: positive -> proof -> proof -| I_Or_l: proof -> proof -| I_Or_r: proof -> proof -| E_Or: positive -> proof -> proof -> proof -| D_Or: positive -> proof -> proof -| Cut: form -> proof -> proof -> proof. - -Notation "hyps \ A" := (push A hyps) (at level 72,left associativity). - -Fixpoint check_proof (hyps:ctx) (gl:form) (P:proof) {struct P}: bool := - match P with - Ax i => - match get i hyps with - PSome F => form_eq F gl - | _ => false - end -| I_Arrow p => - match gl with - A =>> B => check_proof (hyps \ A) B p - | _ => false - end -| E_Arrow i j p => - match get i hyps,get j hyps with - PSome A,PSome (B =>>C) => - form_eq A B && check_proof (hyps \ C) (gl) p - | _,_ => false - end -| D_Arrow i p1 p2 => - match get i hyps with - PSome ((A =>>B)=>>C) => - (check_proof ( hyps \ B =>> C \ A) B p1) && (check_proof (hyps \ C) gl p2) - | _ => false - end -| E_False i => - match get i hyps with - PSome # => true - | _ => false - end -| I_And p1 p2 => - match gl with - A //\\ B => - check_proof hyps A p1 && check_proof hyps B p2 - | _ => false - end -| E_And i p => - match get i hyps with - PSome (A //\\ B) => check_proof (hyps \ A \ B) gl p - | _=> false - end -| D_And i p => - match get i hyps with - PSome (A //\\ B =>> C) => check_proof (hyps \ A=>>B=>>C) gl p - | _=> false - end -| I_Or_l p => - match gl with - (A \\// B) => check_proof hyps A p - | _ => false - end -| I_Or_r p => - match gl with - (A \\// B) => check_proof hyps B p - | _ => false - end -| E_Or i p1 p2 => - match get i hyps with - PSome (A \\// B) => - check_proof (hyps \ A) gl p1 && check_proof (hyps \ B) gl p2 - | _=> false - end -| D_Or i p => - match get i hyps with - PSome (A \\// B =>> C) => - (check_proof (hyps \ A=>>C \ B=>>C) gl p) - | _=> false - end -| Cut A p1 p2 => - check_proof hyps A p1 && check_proof (hyps \ A) gl p2 -end. - -Theorem interp_proof: -forall p hyps F gl, -check_proof hyps gl p = true -> interp_ctx hyps F [[gl]]. - -induction p; intros hyps F gl. - -- (* Axiom *) - simpl;case_eq (get p hyps);clean. - intros f nth_f e;rewrite <- (form_eq_refl e). - apply project with p;trivial. - -- (* Arrow_Intro *) - destruct gl; clean. - simpl; intros. - change (interp_ctx (hyps\gl1) (F_push gl1 hyps F) [[gl2]]). - apply IHp; try constructor; trivial. - -- (* Arrow_Elim *) - simpl check_proof; case_eq (get p hyps); clean. - intros f ef; case_eq (get p0 hyps); clean. - intros f0 ef0; destruct f0; clean. - case_eq (form_eq f f0_1); clean. - simpl; intros e check_p1. - generalize (project F ef) (project F ef0) - (IHp (hyps \ f0_2) (F_push f0_2 hyps F) gl check_p1); - clear check_p1 IHp p p0 p1 ef ef0. - simpl. - apply compose3. - rewrite (form_eq_refl e). - auto. - -- (* Arrow_Destruct *) - simpl; case_eq (get p1 hyps); clean. - intros f ef; destruct f; clean. - destruct f1; clean. - case_eq (check_proof (hyps \ f1_2 =>> f2 \ f1_1) f1_2 p2); clean. - intros check_p1 check_p2. - generalize (project F ef) - (IHp1 (hyps \ f1_2 =>> f2 \ f1_1) - (F_push f1_1 (hyps \ f1_2 =>> f2) - (F_push (f1_2 =>> f2) hyps F)) f1_2 check_p1) - (IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2). - simpl; apply compose3; auto. - -- (* False_Elim *) - simpl; case_eq (get p hyps); clean. - intros f ef; destruct f; clean. - intros _; generalize (project F ef). - apply compose1; apply False_ind. - -- (* And_Intro *) - simpl; destruct gl; clean. - case_eq (check_proof hyps gl1 p1); clean. - intros Hp1 Hp2;generalize (IHp1 hyps F gl1 Hp1) (IHp2 hyps F gl2 Hp2). - apply compose2 ; simpl; auto. - -- (* And_Elim *) - simpl; case_eq (get p hyps); clean. - intros f ef; destruct f; clean. - intro check_p; - generalize (project F ef) - (IHp (hyps \ f1 \ f2) (F_push f2 (hyps \ f1) (F_push f1 hyps F)) gl check_p). - simpl; apply compose2; intros [h1 h2]; auto. - -- (* And_Destruct*) - simpl; case_eq (get p hyps); clean. - intros f ef; destruct f; clean. - destruct f1; clean. - intro H; - generalize (project F ef) - (IHp (hyps \ f1_1 =>> f1_2 =>> f2) - (F_push (f1_1 =>> f1_2 =>> f2) hyps F) gl H); - clear H; simpl. - apply compose2; auto. - -- (* Or_Intro_left *) - destruct gl; clean. - intro Hp; generalize (IHp hyps F gl1 Hp). - apply compose1; simpl; auto. - -- (* Or_Intro_right *) - destruct gl; clean. - intro Hp; generalize (IHp hyps F gl2 Hp). - apply compose1; simpl; auto. - -- (* Or_elim *) - simpl; case_eq (get p1 hyps); clean. - intros f ef; destruct f; clean. - case_eq (check_proof (hyps \ f1) gl p2); clean. - intros check_p1 check_p2; - generalize (project F ef) - (IHp1 (hyps \ f1) (F_push f1 hyps F) gl check_p1) - (IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2); - simpl; apply compose3; simpl; intro h; destruct h; auto. - -- (* Or_Destruct *) - simpl; case_eq (get p hyps); clean. - intros f ef; destruct f; clean. - destruct f1; clean. - intro check_p0; - generalize (project F ef) - (IHp (hyps \ f1_1 =>> f2 \ f1_2 =>> f2) - (F_push (f1_2 =>> f2) (hyps \ f1_1 =>> f2) - (F_push (f1_1 =>> f2) hyps F)) gl check_p0); - simpl. - apply compose2; auto. - -- (* Cut *) - simpl; case_eq (check_proof hyps f p1); clean. - intros check_p1 check_p2; - generalize (IHp1 hyps F f check_p1) - (IHp2 (hyps\f) (F_push f hyps F) gl check_p2); - simpl; apply compose2; auto. -Qed. - -Theorem Reflect: forall gl prf, if check_proof empty gl prf then [[gl]] else True. -intros gl prf;case_eq (check_proof empty gl prf);intro check_prf. -change (interp_ctx empty F_empty [[gl]]) ; -apply interp_proof with prf;assumption. -trivial. -Qed. - -End with_env. - -(* -(* A small example *) -Parameters A B C D:Prop. -Theorem toto:A /\ (B \/ C) -> (A /\ B) \/ (A /\ C). -exact (Reflect (empty \ A \ B \ C) -([1] //\\ ([2] \\// [3]) =>> [1] //\\ [2] \\// [1] //\\ [3]) -(I_Arrow (E_And 1 (E_Or 3 - (I_Or_l (I_And (Ax 2) (Ax 4))) - (I_Or_r (I_And (Ax 2) (Ax 4))))))). -Qed. -Print toto. -*) - -Register Reflect as plugins.rtauto.Reflect. - -Register Atom as plugins.rtauto.Atom. -Register Arrow as plugins.rtauto.Arrow. -Register Bot as plugins.rtauto.Bot. -Register Conjunct as plugins.rtauto.Conjunct. -Register Disjunct as plugins.rtauto.Disjunct. - -Register Ax as plugins.rtauto.Ax. -Register I_Arrow as plugins.rtauto.I_Arrow. -Register E_Arrow as plugins.rtauto.E_Arrow. -Register D_Arrow as plugins.rtauto.D_Arrow. -Register E_False as plugins.rtauto.E_False. -Register I_And as plugins.rtauto.I_And. -Register E_And as plugins.rtauto.E_And. -Register D_And as plugins.rtauto.D_And. -Register I_Or_l as plugins.rtauto.I_Or_l. -Register I_Or_r as plugins.rtauto.I_Or_r. -Register E_Or as plugins.rtauto.E_Or. -Register D_Or as plugins.rtauto.D_Or. |
