Skip to content

GitLab

Commit fcc1f0de authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files
Options

More efficient conversion of pmap to association lists.

parent bc659ba4
Hide whitespace changes
Inline Side-by-side
Showing with 73 additions and 61 deletions
theories/pmap.v
View file @ fcc1f0de
......@@ -257,76 +257,84 @@ Lemma Plookup_fmap {A B} (f : A → B) (t : Pmap_raw A) i :
fmap f t !! i = fmap f (t !! i).
Proof. revert i. induction t. done. by intros [?|?|]; simpl. Qed.
Fixpoint Pto_list_raw {A} (j: positive) (t: Pmap_raw A) : list (positive * A) :=
Fixpoint Pto_list_raw {A} (j: positive) (t: Pmap_raw A)
(acc : list (positive * A)) : list (positive * A) :=
match t with
| PLeaf => []
| PNode l o r => default [] o (λ x, [(Preverse j, x)]) ++
Pto_list_raw (j~0) l ++ Pto_list_raw (j~1) r
| PLeaf => acc
| PNode l o r => default [] o (λ x, [(Preverse j, x)]) ++
Pto_list_raw (j~0) l (Pto_list_raw (j~1) r acc)
end%list.
Lemma Pelem_of_to_list_aux {A} (t : Pmap_raw A) j i x :
(i,x) ∈ Pto_list_raw j t ↔ ∃ i', i = i' ++ Preverse j ∧ t !! i' = Some x.
Lemma Pelem_of_to_list {A} (t : Pmap_raw A) j i acc x :
(i,x) ∈ Pto_list_raw j t acc ↔
(∃ i', i = i' ++ Preverse j ∧ t !! i' = Some x) ∨ (i,x) ∈ acc.
Proof.
split.
* revert j. induction t as [|? IHl [?|] ? IHr]; intros j; simpl.
+ by rewrite ?elem_of_nil.
+ rewrite elem_of_cons, !elem_of_app. intros [?|[?|?]].
- simplify_equality. exists 1. by rewrite (left_id_L 1 (++))%positive.
- destruct (IHl (j~0)) as (i' &?&?); trivial; subst.
exists (i' ~ 0). by rewrite Preverse_xO, (associative_L _).
- destruct (IHr (j~1)) as (i' &?&?); trivial; subst.
exists (i' ~ 1). by rewrite Preverse_xI, (associative_L _).
+ rewrite !elem_of_app. intros [?|?].
- destruct (IHl (j~0)) as (i' &?&?); trivial; subst.
exists (i' ~ 0). by rewrite Preverse_xO, (associative_L _).
- destruct (IHr (j~1)) as (i' &?&?); trivial; subst.
exists (i' ~ 1). by rewrite Preverse_xI, (associative_L _).
* intros (i' & ?& Hi'); subst. revert i' j Hi'.
induction t as [|? IHl [?|] ? IHr]; intros i j; simpl.
+ done.
+ rewrite elem_of_cons, elem_of_app. destruct i as [i|i|]; simpl in *.
- right. right. specialize (IHr i (j~1)).
rewrite Preverse_xI, (associative_L _) in IHr. auto.
- right. left. specialize (IHl i (j~0)).
rewrite Preverse_xO, (associative_L _) in IHl. auto.
- left. simplify_equality. by rewrite (left_id_L 1 (++))%positive.
+ rewrite elem_of_app. destruct i as [i|i|]; simpl in *.
- right. specialize (IHr i (j~1)).
rewrite Preverse_xI, (associative_L _) in IHr. auto.
- left. specialize (IHl i (j~0)).
rewrite Preverse_xO, (associative_L _) in IHl. auto.
- done.
Qed.
Lemma Pelem_of_to_list {A} (t : Pmap_raw A) i x :
(i,x) ∈ Pto_list_raw 1 t ↔ t !! i = Some x.
Proof.
rewrite Pelem_of_to_list_aux. split. by intros (i'&->&?). intros. by exists i.
{ revert j acc. induction t as [|l IHl [y|] r IHr]; intros j acc; simpl.
* by right.
* rewrite elem_of_cons. intros [?|?]; simplify_equality.
{ left; exists 1. by rewrite (left_id_L 1 (++))%positive. }
destruct (IHl (j~0) (Pto_list_raw j~1 r acc)) as [(i'&->&?)|?]; auto.
{ left; exists (i' ~ 0). by rewrite Preverse_xO, (associative_L _). }
destruct (IHr (j~1) acc) as [(i'&->&?)|?]; auto.
left; exists (i' ~ 1). by rewrite Preverse_xI, (associative_L _).
* intros.
destruct (IHl (j~0) (Pto_list_raw j~1 r acc)) as [(i'&->&?)|?]; auto.
{ left; exists (i' ~ 0). by rewrite Preverse_xO, (associative_L _). }
destruct (IHr (j~1) acc) as [(i'&->&?)|?]; auto.
left; exists (i' ~ 1). by rewrite Preverse_xI, (associative_L _). }
revert t j i acc. assert (∀ t j i acc,
(i, x) ∈ acc → (i, x) ∈ Pto_list_raw j t acc) as help.
{ intros t; induction t as [|l IHl [y|] r IHr]; intros j i acc;
simpl; rewrite ?elem_of_cons; auto. }
intros t j ? acc [(i&->&Hi)|?]; [|by auto]. revert j i acc Hi.
induction t as [|l IHl [y|] r IHr]; intros j i acc ?; simpl.
* done.
* rewrite elem_of_cons. destruct i as [i|i|]; simplify_equality'.
+ right. apply help. specialize (IHr (j~1) i).
rewrite Preverse_xI, (associative_L _) in IHr. by apply IHr.
+ right. specialize (IHl (j~0) i).
rewrite Preverse_xO, (associative_L _) in IHl. by apply IHl.
+ left. by rewrite (left_id_L 1 (++))%positive.
* destruct i as [i|i|]; simplify_equality'.
+ apply help. specialize (IHr (j~1) i).
rewrite Preverse_xI, (associative_L _) in IHr. by apply IHr.
+ specialize (IHl (j~0) i).
rewrite Preverse_xO, (associative_L _) in IHl. by apply IHl.
Qed.
Lemma Pto_list_nodup {A} j (t : Pmap_raw A) : NoDup (Pto_list_raw j t).
Lemma Pto_list_nodup {A} j (t : Pmap_raw A) acc :
(∀ i x, (i ++ Preverse j, x) ∈ acc → t !! i = None) →
NoDup acc → NoDup (Pto_list_raw j t acc).
Proof.
revert j. induction t as [|? IHl [?|] ? IHr]; simpl.
* constructor.
* intros. rewrite NoDup_cons, NoDup_app. split_ands; trivial.
+ rewrite elem_of_app, !Pelem_of_to_list_aux.
intros [(i&Hi&?)|(i&Hi&?)].
- rewrite Preverse_xO in Hi. apply (f_equal Plength) in Hi.
rewrite !Papp_length in Hi. simpl in Hi. lia.
- rewrite Preverse_xI in Hi. apply (f_equal Plength) in Hi.
rewrite !Papp_length in Hi. simpl in Hi. lia.
+ intros [??]. rewrite !Pelem_of_to_list_aux.
intros (i1&?&?) (i2&Hi&?); subst.
rewrite Preverse_xO, Preverse_xI, !(associative_L _) in Hi.
by apply (injective (++ _)) in Hi.
* intros. rewrite NoDup_app. split_ands; trivial.
intros [??]. rewrite !Pelem_of_to_list_aux.
intros (i1&?&?) (i2&Hi&?); subst.
rewrite Preverse_xO, Preverse_xI, !(associative_L _) in Hi.
by apply (injective (++ _)) in Hi.
revert j acc. induction t as [|l IHl [y|] r IHr]; simpl; intros j acc Hin ?.
* done.
* repeat constructor.
{ rewrite Pelem_of_to_list. intros [(i&Hi&?)|Hj].
{ apply (f_equal Plength) in Hi.
rewrite Preverse_xO, !Papp_length in Hi; simpl in *; lia. }
rewrite Pelem_of_to_list in Hj. destruct Hj as [(i&Hi&?)|Hj].
{ apply (f_equal Plength) in Hi.
rewrite Preverse_xI, !Papp_length in Hi; simpl in *; lia. }
specialize (Hin 1 y). rewrite (left_id_L 1 (++))%positive in Hin.
discriminate (Hin Hj). }
apply IHl.
{ intros i x. rewrite Pelem_of_to_list. intros [(?&Hi&?)|Hi].
+ rewrite Preverse_xO, Preverse_xI, !(associative_L _) in Hi.
by apply (injective (++ _)) in Hi.
+ apply (Hin (i~0) x). by rewrite Preverse_xO, (associative_L _) in Hi. }
apply IHr; auto. intros i x Hi.
apply (Hin (i~1) x). by rewrite Preverse_xI, (associative_L _) in Hi.
* apply IHl.
{ intros i x. rewrite Pelem_of_to_list. intros [(?&Hi&?)|Hi].
+ rewrite Preverse_xO, Preverse_xI, !(associative_L _) in Hi.
by apply (injective (++ _)) in Hi.
+ apply (Hin (i~0) x). by rewrite Preverse_xO, (associative_L _) in Hi. }
apply IHr; auto. intros i x Hi.
apply (Hin (i~1) x). by rewrite Preverse_xI, (associative_L _) in Hi.
Qed.
Global Instance Pto_list {A} : FinMapToList positive A (Pmap A) :=
λ t, Pto_list_raw 1 (`t).
λ t, Pto_list_raw 1 (`t) [].
Fixpoint Pmerge_aux `(f : option A → option B) (t : Pmap_raw A) : Pmap_raw B :=
match t with
......@@ -385,7 +393,11 @@ Proof.
* intros ?? [??] ??. by apply Plookup_alter_ne.
* intros ??? [??]. by apply Plookup_fmap.
* intros ? [??]. apply Pto_list_nodup.
* intros ? [??]. apply Pelem_of_to_list.
+ intros ??. by rewrite elem_of_nil.
+ constructor.
* intros ? [??] i x; unfold map_to_list, Pto_list.
rewrite Pelem_of_to_list, elem_of_nil.
split. by intros [(?&->&?)|]. by left; exists i.
* intros ??? ?? [??] [??] ?. by apply Pmerge_spec.
Qed.
......
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