Commit cfcefac4 authored by Samuel Ben Hamou's avatar Samuel Ben Hamou
Browse files

Du ménage dans Peano.v et une coquille corrigée dans ZF.v.

parent f0abfe1e
......@@ -13,8 +13,8 @@ Local Open Scope eqb_scope.
Definition PeanoSign := Finite.to_infinite peano_sign.
Definition Zero := Fun "O" [].
Definition Succ x := Fun "S" [x].
Notation Zero := (Fun "O" []).
Notation Succ x := (Fun "S" [x]).
Notation "x = y" := (Pred "=" [x;y]) : formula_scope.
Notation "x + y" := (Fun "+" [x;y]) : formula_scope.
......@@ -180,31 +180,85 @@ Proof.
assumption.
Qed.
Ltac axiom ax name :=
Lemma IsAx_adhoc form :
check PeanoSign form = true ->
FClosed form ->
Forall IsAx (induction_schema form ::axioms_list).
Proof.
intros.
apply Forall_forall.
intros x Hx.
destruct Hx.
+ simpl. unfold IsAx. right. exists form. split; [ auto | split; [ auto | auto ]].
+ simpl. unfold IsAx. left. assumption.
Qed.
Lemma rec0_rule l G A_x :
BClosed ( A_x) ->
In (induction_schema A_x) G ->
Pr l (G bsubst 0 Zero A_x) ->
Pr l (G (A_x -> bsubst 0 (Succ(#0)) A_x)) ->
Pr l (G A_x).
Proof.
intros.
eapply R_Imp_e.
+ apply R_Ax.
unfold induction_schema in H0.
unfold BClosed in H.
cbn in H.
rewrite H in H0.
cbn in H0.
apply H0.
+ simpl.
apply R_And_i; cbn.
* set (v := fresh (fvars (G bsubst 0 Zero A_x)%form)).
apply R_All_i with (x:=v).
apply fresh_ok.
rewrite form_level_bsubst_id.
- assumption.
- apply level_bsubst.
++ unfold BClosed in H. cbn in H; omega.
++ cbn; omega.
* assumption.
Qed.
(* And tactics to make the proofs look like natural deduction proofs. *)
Ltac calc :=
match goal with
| |- Pr ?l (?ctx _) => assert (name : Pr l (ctx ax)); [ apply R_Ax; compute; intuition | ]; unfold ax in name
| |- BClosed _ => reflexivity
| |- In _ _ => rewrite <- list_mem_in; reflexivity
| |- ~Names.In _ _ => rewrite<- Names.mem_spec; now compute
| _ => idtac
end.
Ltac app_R_All_i t := apply R_All_i with (x := t); [ rewrite<- Names.mem_spec; now compute | ].
Ltac eapp_R_All_i := eapply R_All_i; [ rewrite<- Names.mem_spec; now compute | ].
Ltac inst H l :=
match l with
| [] => idtac
| (?u::?l) => apply R_All_e with (t := u) in H; [ inst H l | calc ]
end.
Ltac sym := apply Symmetry; [ auto | auto | compute; intuition | ].
Ltac axiom ax name :=
match goal with
| |- Pr ?l (?ctx _) => assert (name : Pr l (ctx ax)); [ apply R_Ax; calc | ]; unfold ax in name
end.
Ltac ahered := apply Hereditarity; [ auto | auto | compute; intuition | ].
Ltac inst_axiom ax l :=
let H := fresh in
axiom ax H; inst H l; easy.
Ltac hered := apply AntiHereditarity; [ auto | auto | compute; intuition | ].
Ltac app_R_All_i t v := apply R_All_i with (x := t); calc; cbn; set (v := FVar t).
Ltac eapp_R_All_i := eapply R_All_i; calc.
Ltac trans b := apply Transitivity with (B := b); [ auto | auto | auto | compute; intuition | | ].
Ltac sym := apply Symmetry; calc.
Ltac thm := unfold IsTheorem; split; [ unfold Wf; split; [ auto | split; auto ] | ].
Ltac ahered := apply Hereditarity; calc.
Ltac change_succ :=
match goal with
| |- context[ Fun "S" [?t] ] => change (Fun "S" [t]) with (Succ (t)); change_succ
| _ => idtac
end.
Ltac hered := apply AntiHereditarity; calc.
Ltac cbm := cbn; change (Fun "O" []) with Zero; change_succ.
Ltac trans b := apply Transitivity with (B := b); calc.
Ltac thm := unfold IsTheorem; split; [ unfold Wf; split; [ auto | split; auto ] | ].
Ltac parse term :=
match term with
......@@ -216,15 +270,10 @@ Ltac rec :=
match goal with
| |- exists axs, (Forall (IsAxiom PeanoTheory) axs /\ Pr ?l (axs ?A))%type =>
let form := parse A in
exists (induction_schema form :: axioms_list); set (Γ := induction_schema form :: axioms_list); set (rec := induction_schema form); split;
[ apply Forall_forall; intros x H; destruct H;
[ simpl; unfold IsAx; right; exists form ; split;
[ auto | split; [ auto | auto ]] |
simpl; unfold IsAx; left; assumption ] |
exists (induction_schema form :: axioms_list); set (rec := induction_schema form); set (Γ := rec :: axioms_list); split;
[ apply IsAx_adhoc; auto |
repeat apply R_Imp_i;
eapply R_Imp_e;
[ apply R_Ax; unfold induction_schema; cbm; intuition | simpl; apply R_And_i; cbn ]
]; cbm
apply rec0_rule; calc ]; cbn
(* | _ => idtac *)
end.
......@@ -235,17 +284,13 @@ Lemma ZeroRight : IsTheorem Intuiti PeanoTheory (∀ (#0 = #0 + Zero)).
Proof.
thm.
rec.
+ app_R_All_i "y". cbm.
sym.
axiom ax9 AX9.
apply R_All_e with (t := Zero) in AX9; auto.
+ app_R_All_i "y". cbm.
apply R_Imp_i. set (H1 := FVar _ = _).
+ sym.
inst_axiom ax9 [Zero].
+ app_R_All_i "y" y.
apply R_Imp_i. set (H1 := _ = _).
sym.
trans (Succ ((FVar "y") + Zero)).
- axiom ax10 AX10.
apply R_All_e with (t := FVar "y") in AX10; auto.
apply R_All_e with (t := Zero) in AX10; auto.
trans (Succ (y + Zero)).
- inst_axiom ax10 [y; Zero].
- ahered.
sym.
apply R_Ax.
......@@ -256,38 +301,27 @@ Lemma SuccRight : IsTheorem Intuiti PeanoTheory (∀∀ (Succ(#1 + #0) = #1 + Su
Proof.
thm.
rec.
+ app_R_All_i "x".
app_R_All_i "y".
cbm.
+ app_R_All_i "y" y.
sym.
trans (Succ (FVar "y")).
- axiom ax9 AX9.
apply R_All_e with (t := Succ (FVar "y")) in AX9; auto.
trans (Succ y).
- inst_axiom ax9 [Succ y].
- ahered.
sym.
axiom ax9 AX9.
apply R_All_e with (t := FVar "y") in AX9; auto.
+ app_R_All_i "x".
cbm.
inst_axiom ax9 [y].
+ app_R_All_i "x" x.
apply R_Imp_i.
app_R_All_i "y".
cbm.
app_R_All_i "y" y. fold x.
set (hyp := Succ _ = _).
trans (Succ (Succ (FVar "x" + FVar "y"))).
trans (Succ (Succ (x + y))).
- ahered.
axiom ax10 AX10.
apply R_All_e with (t := FVar "x") in AX10; auto.
apply R_All_e with (t := FVar "y") in AX10; auto.
- trans (Succ (FVar "x" + Succ (FVar "y"))).
inst_axiom ax10 [x; y].
- trans (Succ (x + Succ y)).
* ahered.
axiom hyp Hyp.
apply R_All_e with (t := FVar "y") in Hyp; auto.
* axiom ax10 AX10.
sym.
apply R_All_e with (t := FVar "x") in AX10; auto.
apply R_All_e with (t := Succ (FVar "y")) in AX10; auto.
inst_axiom hyp [y].
* sym.
inst_axiom ax10 [x; Succ y].
Qed.
Lemma Comm :
IsTheorem Intuiti PeanoTheory
(( #0 = #0 + Zero) -> (∀∀ Succ(#1 + #0) = #1 + Succ(#0)) ->
......@@ -295,35 +329,27 @@ Lemma Comm :
Proof.
thm.
rec; set (Γ' := _ :: _ :: Γ).
+ app_R_All_i "x".
cbm.
app_R_All_i "x".
cbm.
trans (FVar "x").
+ app_R_All_i "x" x.
trans x.
- sym.
assert (Pr Intuiti (Γ' # 0 = # 0 + Zero)). { apply R_Ax. simpl in *; intuition. }
apply R_All_e with (t := FVar "x") in H; auto.
assert (Pr Intuiti (Γ' # 0 = # 0 + Zero)). { apply R_Ax. calc. }
apply R_All_e with (t := x) in H; auto.
- sym.
axiom ax9 AX9.
apply R_All_e with (t := FVar "x") in AX9; auto.
+ app_R_All_i "y".
cbm.
inst_axiom ax9 [x].
+ app_R_All_i "y" y.
apply R_Imp_i.
app_R_All_i "x".
cbm.
trans (Succ (FVar "x" + FVar "y")).
app_R_All_i "x" x.
trans (Succ (x + y)).
- sym.
assert (Pr Intuiti (( # 0 + FVar "y" = FVar "y" + # 0) :: Γ' Succ (#1 + #0) = #1 + Succ (#0))). { apply R_Ax. simpl in *; intuition. }
apply R_All_e with (t := FVar "x") in H; auto.
apply R_All_e with (t := FVar "y") in H; auto.
- trans (Succ (FVar "y" + FVar "x")).
assert (Pr Intuiti (( #0 + y = y + #0) :: Γ' Succ (#1 + #0) = #1 + Succ (#0))). { apply R_Ax. calc. }
apply R_All_e with (t := x) in H; auto.
apply R_All_e with (t := y) in H; auto.
- trans (Succ (y + x)).
* ahered.
assert (Pr Intuiti (( #0 + FVar "y" = FVar "y" + #0) :: Γ' #0 + FVar "y" = FVar "y" + #0)). { apply R_Ax. apply in_eq. }
apply R_All_e with (t := FVar "x") in H; auto.
assert (Pr Intuiti (( #0 + y = y + #0) :: Γ' #0 + y = y + #0)). { apply R_Ax. apply in_eq. }
apply R_All_e with (t := x) in H; auto.
* sym.
axiom ax10 AX10.
apply R_All_e with (t := FVar "y") in AX10; auto.
apply R_All_e with (t := FVar "x") in AX10; auto.
inst_axiom ax10 [y; x].
Qed.
Lemma Commutativity : IsTheorem Intuiti PeanoTheory (∀∀ #0 + #1 = #1 + #0).
......@@ -334,7 +360,7 @@ Proof.
* apply ZeroRight.
+ apply SuccRight.
Qed.
(** A Coq model of this Peano theory, based on the [nat] type *)
Definition PeanoFuns : modfuns nat :=
......@@ -380,7 +406,7 @@ Proof.
unfold PeanoTheory. simpl.
unfold PeanoAx.IsAx.
intros [IN|(B & -> & CK & CL)].
- compute in IN. intuition; subst; cbn; intros; subst; omega.
- compute in IN. calc; subst; cbn; intros; subst; omega.
- intros genv.
unfold PeanoAx.induction_schema.
apply interp_nforall.
......
......@@ -26,7 +26,7 @@ Definition compat_right := ∀∀∀ (#0 ∈ #1 /\ #1 = #2 -> #0 ∈ #2).
Definition ext := ∀∀ ( (#2 #0 <-> #2 #1) -> #0 = #1).
Definition pairing := ∀∀∃∀ (#3 #2 <-> #3 = #0 \/ #3 = #1).
Definition union := ∀∃∀ (#2 #1 <-> (#3 #0 /\ #2 #3).
Definition union := ∀∃∀ (#2 #1 <-> (#3 #0 /\ #2 #3)).
Definition powerset := ∀∃∀ (#2 #1 <-> (#3 #2 -> #3 #0)).
Definition infinity := ( (#1 #0 /\ not #2 #1) /\ (#3 #0 -> ( (#4 #0 /\ ( (#5 #4 <-> #5 = #3 \/ #5 #3)))))).
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment