Commit 93a88ce7 authored by Johannes Kloos's avatar Johannes Kloos

Simplified the correctness proof of generic_fresh.

parent 3a262d02
...@@ -308,64 +308,51 @@ Section Fresh. ...@@ -308,64 +308,51 @@ Section Fresh.
apply relfg. apply relfg.
Qed. Qed.
Global Instance fresh_generic: Fresh A C | 20 := Definition fresh_generic_fix := Fix collection_wf (const (nat A)) fresh_generic_body.
λ s, Fix collection_wf (const (nat A)) fresh_generic_body s 0.
Lemma fresh_generic_fixpoint_unfold s n:
fresh_generic_fix s n = fresh_generic_body s (λ s' _ n, fresh_generic_fix s' n) n.
Proof.
apply (Fix_unfold_rel collection_wf (const (nat A)) (const (pointwise_relation nat (=)))
fresh_generic_body fresh_generic_body_proper s n).
Qed.
Lemma fresh_generic_fixpoint_spec s n:
m, n m fresh_generic_fix s n = inject m inject m s i, n i < m inject i s.
Proof.
revert n.
induction s as [s IH] using (well_founded_ind collection_wf); intro.
setoid_rewrite fresh_generic_fixpoint_unfold; unfold fresh_generic_body.
destruct decide as [case|case].
- destruct (IH _ (subset_difference_in case) (S n)) as [m [mbound [eqfix [notin inbelow]]]].
exists m; repeat split; auto.
+ omega.
+ rewrite not_elem_of_difference, elem_of_singleton in notin.
destruct notin as [?|?%inject_injective]; auto; omega.
+ intros i ibound.
destruct (decide (i = n)) as [<-|neq]; auto.
enough (inject i s {[inject n]}) by set_solver.
apply inbelow; omega.
- exists n; repeat split; auto.
intros; omega.
Qed.
Global Instance fresh_generic: Fresh A C | 20 := λ s, fresh_generic_fix s 0.
Global Instance fresh_generic_spec: FreshSpec A C. Global Instance fresh_generic_spec: FreshSpec A C.
Proof. Proof.
assert (unfold: s n,
Fix collection_wf (const (nat A)) fresh_generic_body s n =
fresh_generic_body s
(λ s' _ n, Fix collection_wf (const (nat A)) fresh_generic_body s' n)
n).
{ intros.
apply (Fix_unfold_rel collection_wf (const (nat A)) (const (pointwise_relation nat (=)))
fresh_generic_body fresh_generic_body_proper s n). }
split. split.
- apply _. - apply _.
- unfold fresh, fresh_generic. - intros * eqXY.
intro X. unfold fresh, fresh_generic.
generalize 0 as n. destruct (fresh_generic_fixpoint_spec X 0) as [mX [_ [-> [notinX belowinX]]]].
induction X as [X IH] using (well_founded_ind collection_wf). destruct (fresh_generic_fixpoint_spec Y 0) as [mY [_ [-> [notinY belowinY]]]].
intros n Y eqXY. destruct (Nat.lt_trichotomy mX mY) as [case|[->|case]]; auto.
rewrite (unfold X n), (unfold Y n). + contradict notinX; rewrite eqXY; apply belowinY; omega.
unfold fresh_generic_body at 1 3. + contradict notinY; rewrite <- eqXY; apply belowinX; omega.
destruct decide as [case|case], decide as [case'|case']. - intro.
2,3: specialize (eqXY (inject n)); tauto. unfold fresh, fresh_generic.
2: done. destruct (fresh_generic_fixpoint_spec X 0) as [m [_ [-> [notinX belowinX]]]]; auto.
erewrite (IH (X {[inject n]})).
+ done.
+ by apply subset_difference_in.
+ by intro; rewrite !elem_of_difference, eqXY.
- unfold fresh, fresh_generic.
intro X.
generalize 0 as n.
induction X as [X IH] using (well_founded_ind collection_wf).
intro.
rewrite unfold; unfold fresh_generic_body at 1.
destruct decide as [case|case].
2: done.
specialize (IH _ (subset_difference_in case) (S n)).
rewrite not_elem_of_difference in IH.
destruct IH as [?|contra].
1: done.
clear case.
assert ( Y n, m, Fix collection_wf (const (nat A))
fresh_generic_body Y n = inject m n m)
as candidates.
{ clear X n contra.
induction Y as [Y IH] using (well_founded_ind collection_wf).
intro.
setoid_rewrite unfold; unfold fresh_generic_body at 1.
destruct decide as [case|case].
{ destruct (IH _ (subset_difference_in case) (S n)) as [m [eqx bound]].
exists m; split; auto with arith. }
{ exists n; auto. } }
revert contra.
destruct (candidates (X {[ inject n ]}) (S n)) as [m [-> bound]].
rewrite elem_of_singleton; intro eqinj.
enough (n = m) by lia.
apply inject_injective; by rewrite eqinj.
Qed. Qed.
End Fresh. End Fresh.
End fin_collection. End fin_collection.
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