### Attempts with PackedCursorList

... | ... | @@ -5,11 +5,24 @@ which must match with the previous element. For that reason this is |

also a snoc list. Note that this is not unlike fhlist from CPDT, | ||

except we place further restrictions on it. *) | ||

From SmartContracts Require Import Automation. | ||

From SmartContracts Require Import Transport. | ||

From Coq Require Import JMeq. | ||

From Coq Require Import Program. | ||

From Coq Require Import List. | ||

Import ListNotations. | ||

Section List. | ||

Definition list_prefix {A : Type} (prefix full : list A) := | ||

exists suffix, full = suffix ++ prefix. | ||

End List. | ||

Infix "`prefix_of`" := list_prefix (at level 70) : list_scope. | ||

Section CursorList. | ||

Context {cursor_type : Type} {elm_type : cursor_type -> cursor_type -> Type}. | ||

Inductive CursorList : cursor_type -> cursor_type -> Type := | ||

| nil : forall {elm}, CursorList elm elm | ||

| clnil : forall {elm}, CursorList elm elm | ||

| snoc : forall {from mid to}, CursorList from mid -> elm_type mid to -> CursorList from to. | ||

Definition snoc_eq | ||

... | ... | @@ -25,30 +38,113 @@ Fixpoint clist_app |

(xs : CursorList from mid) | ||

(ys : CursorList mid to) : CursorList from to := | ||

match ys with | ||

| nil => fun xs => xs | ||

| clnil => fun xs => xs | ||

| snoc ys' y => fun xs => snoc (clist_app xs ys') y | ||

end xs. | ||

Infix "++" := clist_app (right associativity, at level 60). | ||

Definition clist_prefix | ||

Definition clist_prefix_dep | ||

{from mid to} | ||

(prefix : CursorList from mid) | ||

(full : CursorList from to) : Prop := | ||

exists suffix, full = prefix ++ suffix. | ||

Definition clist_suffix | ||

Definition clist_suffix_dep | ||

{from mid to} | ||

(suffix : CursorList mid to) | ||

(full : CursorList from to) : Prop := | ||

exists prefix, full = prefix ++ suffix. | ||

Infix "`prefix_of`" := clist_prefix (at level 70). | ||

Infix "`suffix_of`" := clist_suffix (at level 70). | ||

Infix "`prefix_of_dep`" := clist_prefix_dep (at level 70). | ||

Infix "`suffix_of_dep`" := clist_suffix_dep (at level 70). | ||

Section Packed. | ||

Record PackedElement := | ||

build_packed_element { | ||

pelm_from : cursor_type; | ||

pelm_to : cursor_type; | ||

pelm : elm_type pelm_from pelm_to; | ||

}. | ||

Arguments build_packed_element {_ _}. | ||

Fixpoint is_chained (prev_from : cursor_type) (xs : list PackedElement) (from : cursor_type) : Prop := | ||

match xs with | ||

| [] => prev_from = from | ||

| x :: xs => prev_from = pelm_to x /\ is_chained (pelm_from x) xs from | ||

end. | ||

Fixpoint clist_to_packed_aux {from to} (xs : CursorList from to) : list PackedElement := | ||

match xs with | ||

| clnil => [] | ||

| snoc xs x => build_packed_element x :: clist_to_packed_aux xs | ||

end. | ||

Lemma clist_to_packed_aux_wf {from to} (xs : CursorList from to) l : | ||

clist_to_packed_aux xs = l -> is_chained to l from. | ||

Proof. | ||

revert from to xs. | ||

induction l as [|p ps IH]; intros from to xs eq; cbn in *. | ||

- destruct xs; auto; solve_by_inversion. | ||

- destruct xs; inversion eq. | ||

cbn in *. | ||

split; auto. | ||

match goal with | ||

| [H: _ |- _] => now rewrite H; eauto | ||

end. | ||

Defined. | ||

Record PackedCursorList := | ||

build_packed_clist { | ||

packed_from : cursor_type; | ||

packed_to : cursor_type; | ||

packed_list : list PackedElement; | ||

packed_list_wf : is_chained packed_to packed_list packed_from; | ||

}. | ||

Definition clist_to_packed | ||

{from to} | ||

(xs : CursorList from to) : PackedCursorList := | ||

{| packed_from := from; | ||

packed_to := to; | ||

packed_list := clist_to_packed_aux xs; | ||

packed_list_wf := clist_to_packed_aux_wf xs _ eq_refl; | ||

|}. | ||

Fixpoint packed_to_clist_aux {from to ps} (wf : is_chained to ps from) {struct ps} | ||

: CursorList from to. | ||

Proof. | ||

destruct ps as [|p ps']; cbn in *. | ||

- subst; apply clnil. | ||

- destruct wf as [wf_to_eq wf_prefix]. | ||

destruct p as [p_from p_to p]. | ||

cbn in *. | ||

subst. | ||

exact (snoc (packed_to_clist_aux _ _ _ wf_prefix) p). | ||

Defined. | ||

Definition packed_to_clist (ps : PackedCursorList) | ||

: CursorList (packed_from ps) (packed_to ps) := | ||

packed_to_clist_aux (packed_list_wf ps). | ||

Lemma clist_packed_iff {from to} : | ||

inhabited (CursorList from to) <-> | ||

exists (ps : PackedCursorList), packed_from ps = from /\ packed_to ps = to. | ||

Proof. | ||

split. | ||

- intros [xs]. | ||

exists (clist_to_packed xs). | ||

auto. | ||

- intros [ps [from_eq to_eq]]; subst. | ||

constructor. | ||

apply (packed_to_clist ps). | ||

Qed. | ||

End Packed. | ||

Section Theories. | ||

Lemma clist_app_nil_l {from to} (xs : CursorList from to) : | ||

nil ++ xs = xs. | ||

Lemma clist_app_clnil_l {from to} (xs : CursorList from to) : | ||

clnil ++ xs = xs. | ||

Proof. induction xs; auto; cbn; solve_by_rewrite. Qed. | ||

Lemma clist_app_assoc | ||

... | ... | @@ -58,27 +154,52 @@ Lemma clist_app_assoc |

(zs : CursorList c3 c4) : | ||

xs ++ ys ++ zs = (xs ++ ys) ++ zs. | ||

Proof. induction zs; intros; auto; cbn; solve_by_rewrite. Qed. | ||

End Theories. | ||

Lemma prefix_of_app | ||

Lemma prefix_of_dep_refl {from to} (xs : CursorList from to) : | ||

xs `prefix_of_dep` xs. | ||

Proof. now exists clnil. Qed. | ||

Lemma prefix_of_dep_app | ||

{from mid to to'} | ||

{prefix : CursorList from mid} | ||

{xs : CursorList from to} | ||

{suffix : CursorList to to'} : | ||

prefix `prefix_of` xs -> | ||

prefix `prefix_of` xs ++ suffix. | ||

prefix `prefix_of_dep` xs -> | ||

prefix `prefix_of_dep` xs ++ suffix. | ||

Proof. | ||

intros [ex_suffix ex_suffix_eq_app]. | ||

exists (ex_suffix ++ suffix). | ||

rewrite clist_app_assoc; congruence. | ||

Qed. | ||

Lemma prefix_of_snoc | ||

{from mid mid' to} | ||

(xs : CursorList from mid) | ||

(ys : CursorList from mid') | ||

(y : elm_type mid' to) : | ||

xs `prefix_of_dep` snoc ys y -> | ||

{ pf : mid = to & pf # xs = snoc ys y } \/ | ||

xs `prefix_of_dep` ys. | ||

Proof. | ||

intros is_prefix. | ||

destruct is_prefix as [suffix suffix_app_eq]. | ||

destruct suffix; cbn in *. | ||

- left. refine (existT _ eq_refl _); auto. | ||

- right. | ||

dependent destruction suffix_app_eq. | ||

</ |