From 6b2cf244620df542b28c0f63606bac55b181fd48 Mon Sep 17 00:00:00 2001 From: Kenneth Roe Date: Tue, 30 May 2017 19:29:20 -0400 Subject: [PATCH] Update for MEMOCODE2017 paper --- PEDANTIC/AbsExecute.v | 668 +++-- PEDANTIC/AbsState.v | 1118 +++++++-- PEDANTIC/AbsStateInstance.v | 387 +-- PEDANTIC/ClosureHelper.v | 87 + PEDANTIC/Fold.v | 153 +- PEDANTIC/ImpHeap.v | 6 +- PEDANTIC/MagicWandExistsHelper.v | 446 ++++ PEDANTIC/PickElement.v | 287 ++- PEDANTIC/ProgramTactics.v | 62 +- PEDANTIC/SatSolverAux1.v | 3544 +++++++++++++++++++++++++++ PEDANTIC/SatSolverAux1old.v | 1017 ++++++++ PEDANTIC/SatSolverDefs.v | 525 ++-- PEDANTIC/SatSolverMain.v | 1589 +++++++++++- PEDANTIC/SatSolverMergeTheorem1P1.v | 1590 ++++++++++++ PEDANTIC/SatSolverMergeTheorem1P2.v | 184 ++ PEDANTIC/SatSolverMergeTheorem1P3.v | 706 ++++++ PEDANTIC/Simplify.v | 1106 +++++++-- PEDANTIC/StateHypHelper.v | 318 +++ PEDANTIC/Tactics.v | 5 + PEDANTIC/TreeTraversal (original).v | 1420 +++++++++++ PEDANTIC/TreeTraversal.v | 1445 ++++++++--- PEDANTIC/Unfold.v | 439 +++- PEDANTIC/UpdateHelper.v | 61 + PEDANTIC/compile | 11 +- PEDANTIC/merge.v | 559 ++++- PEDANTIC/stateImplication.v | 648 +++-- PEDANTIC/xxx.v | 35 + 27 files changed, 16422 insertions(+), 1994 deletions(-) create mode 100644 PEDANTIC/ClosureHelper.v create mode 100644 PEDANTIC/MagicWandExistsHelper.v create mode 100644 PEDANTIC/SatSolverAux1.v create mode 100644 PEDANTIC/SatSolverAux1old.v create mode 100644 PEDANTIC/SatSolverMergeTheorem1P1.v create mode 100644 PEDANTIC/SatSolverMergeTheorem1P2.v create mode 100644 PEDANTIC/SatSolverMergeTheorem1P3.v create mode 100644 PEDANTIC/StateHypHelper.v create mode 100644 PEDANTIC/TreeTraversal (original).v create mode 100644 PEDANTIC/UpdateHelper.v create mode 100644 PEDANTIC/xxx.v diff --git a/PEDANTIC/AbsExecute.v b/PEDANTIC/AbsExecute.v index 5fe2338..cad9b15 100644 --- a/PEDANTIC/AbsExecute.v +++ b/PEDANTIC/AbsExecute.v @@ -26,6 +26,7 @@ * **********************************************************************************) +Require Import Omega. Require Export SfLib. Require Export ImpHeap. Require Export AbsState. @@ -54,16 +55,42 @@ Require Export FunctionalExtensionality. * ***************************************************************************) -Definition absExecute {ev} {eq} {f} {t} {ac} (ff : functions) (c : com) (s : @absState ev eq f t ac) (s' : @absState ev eq f t ac) (r : result) : Prop := - forall st st', - realizeState s nil st -> ((exists st', exists r, ceval ff st c st' r) /\ - (ceval ff st c st' r -> realizeState s' nil st')). + Fixpoint In {A:Type} (a:A) (l:list A) : Prop := + match l with + | nil => False + | b :: m => b = a \/ In a m + end. + +Definition absExecute (ff : functions) (c : com) (s : absState) (s' : absState) (r : list absExp) (s'' : absState) (exc : id -> (absExp * absState)) : Prop := + forall st st' i x, + realizeState s nil st -> + ((exists st', exists r, ceval ff st c st' r) /\ + ((ceval ff st c st' NoResult -> realizeState s' nil st') \/ + (ceval ff st c st' (Return x) -> (forall rx, In rx r -> absEval (fst st') nil rx = NatValue x /\ realizeState s'' nil st')) \/ + (ceval ff st c st' (Exception i x) -> (absEval (fst st') nil (fst (exc i)) = NatValue x /\ realizeState (snd (exc i)) nil st')))). + + +Fixpoint evalList env el vl : Prop := + match (el,vl) with + | (nil,nil) => True + | (ef::er,vf::vr) => absEval env nil ef = vf /\ evalList env er vr + | (_,_) => False + end. + +(* + * mergeReturnStates specifies where states need to be merged at the end of processing an if-then-else + *) +Definition mergeReturnStates (Q1 : absState) (Q2 : absState) (Q : absState) (R1 : list absExp) (R2 : list absExp) (R : list absExp) := + (forall s v, realizeState Q1 nil s -> evalList (fst s) R1 v-> (realizeState Q nil s /\ evalList (fst s) R v)) /\ + (forall s v, realizeState Q2 nil s -> evalList (fst s) R2 v-> (realizeState Q nil s /\ evalList (fst s) R v)). (* Our Hoare triple notation is based on the absExecute definition *) -Definition hoare_triple {ev} {eq} {f} {t} {ac} (P : @absState ev eq f t ac) c (Q : @absState ev eq f t ac) r := - absExecute (fun x => fun y => fun z => fun a => fun b => False) c P Q r. +Definition hoare_triple (P : absState) c (Q : absState) r Qr exc := + absExecute (fun x => fun y => fun z => fun a => fun b => False) c P Q r Qr exc. + +Notation "{{ P }} c {{ Q }}" := (hoare_triple P c Q (#0) AbsNone (fun x => (#0,AbsNone))) (at level 90). -Notation "{{ P }} c {{ Q , r }}" := (hoare_triple P c Q r) (at level 90). +Notation "{{ P }} c {{ Q 'return' rr 'with' QQ }}" := (hoare_triple P c Q rr QQ (fun x => (#0,AbsNone))) (at level 90). (* ************************************************************************** * @@ -71,12 +98,22 @@ Notation "{{ P }} c {{ Q , r }}" := (hoare_triple P c Q r) (at level 90). * * **************************************************************************) -Theorem strengthenPost : forall ev eq f t ac (P : @absState ev eq f t ac) c Q r Q', - {{ P }} c {{ Q , r }} -> +Fixpoint equivEvalList env el1 el2 : Prop := + match (el1,el2) with + | (nil,nil) => True + | (ef::er,vf::vr) => absEval env nil ef = absEval env nil vf /\ equivEvalList env er vr + | (_,_) => False + end. + +Theorem strengthenPost : forall (P : absState) c Q r Q' QQ QQ' r', + {{ P }} c {{ Q return r with QQ }} -> (forall s, realizeState Q nil s -> realizeState Q' nil s) -> - {{ P }} c {{ Q' , r }}. -Proof. - unfold hoare_triple. unfold absExecute. intros. + (forall s, realizeState QQ nil s -> realizeState QQ' nil s) -> + (forall s, realizeState QQ nil s -> realizeState QQ' nil s -> + equivEvalList (fst s) r r' ) -> + {{ P }} c {{ Q' return r' with QQ' }}. +Proof. admit. + (*unfold hoare_triple. unfold absExecute. intros. assert (forall st st' : state, realizeState P nil st -> @@ -112,8 +149,8 @@ Proof. eapply H2. apply st'. apply H1. - intros. apply H0. eapply H3. apply H1. apply H4. -Qed. + intros. apply H0. eapply H3. apply H1. apply H4.*) +Admitted. (* ************************************************************************** * @@ -121,22 +158,33 @@ Qed. * * **************************************************************************) -Theorem skip_thm : forall ev eq f t ac (P:@absState ev eq f t ac), - {{ P }}SKIP{{ P,NoResult }}. -Proof. admit. Qed. +Theorem skip_thm : forall (P:absState) r, + {{ P }}SKIP{{ P return r with AbsNone }}. +Proof. admit. Admitted. + +(* ************************************************************************** + * + * Theorem for RETURN + * + * **************************************************************************) + +Theorem return_thm : forall (P:absState) e r, + r = convertToAbsExp e -> + {{ P }}RETURN e{{ AbsNone return (r::nil) with P }}. +Proof. admit. Admitted. (* ************************************************************************** * * Theorems for statement composition * * **************************************************************************) -Theorem compose : forall ev eq f t ac (P:@absState ev eq f t ac) c1 P' c2 Q r, - (forall x st st' f, ceval f st c1 st' x -> x=NoResult) -> - {{ P }} c1 {{ P', NoResult }} -> - {{ P'}} c2 {{ Q , r }} -> - {{ P }} c1;c2 {{ Q , r }}. -Proof. - unfold hoare_triple. unfold absExecute. intros. +Theorem compose : forall (P:absState) c1 P' c2 Q R r1 r2 R' Q' rm, + {{ P }} c1 {{ Q return r1 with P' }} -> + {{ Q }} c2 {{ R return r2 with Q' }} -> + mergeReturnStates P' Q' R' r1 r2 rm -> + {{ P }} c1;c2 {{ R return rm with R' }}. +Proof. admit. + (*unfold hoare_triple. unfold absExecute. intros. assert (forall st st' : state, realizeState P nil st -> @@ -152,7 +200,7 @@ Proof. (ceval (fun (_ : id) (_ : state) (_ : list nat) (_ : state) (_ : result) => False) st0 c1 st' NoResult -> realizeState P' nil st')). - eapply H0. apply H3. inversion H4. apply H5. + eapply H. apply H3. inversion H4. apply H5. assert (forall st st' : state, realizeState P nil st -> (ceval @@ -166,7 +214,7 @@ Proof. (ceval (fun (_ : id) (_ : state) (_ : list nat) (_ : state) (_ : result) => False) st0 c1 st'0 NoResult -> realizeState P' nil st'0)). - eapply H0. apply H4. inversion H6. apply H8. apply H5. + eapply H. apply H4. inversion H6. apply H8. apply H5. assert (forall st st' : state, realizeState P' nil st -> @@ -203,7 +251,7 @@ Proof. assert (realizeState P nil st). apply H2. eapply H3 in H2. - inversion H2. subst. inversion H8. destruct x0. eapply H5 in H4. + inversion H2. subst. inversion H9. destruct x0. eapply H5 in H4. inversion H4. inversion H10. eapply ex_intro. eapply ex_intro. eapply CESeq1. eapply H9. eapply H11. eapply x. @@ -218,8 +266,8 @@ Proof. apply H12. apply H15. apply H2. assert ((Return v)=NoResult). eapply H. apply H14. inversion H7. - assert (Exception name val=NoResult). eapply H. apply H14. inversion H7. -Qed. + assert (Exception name val=NoResult). eapply H. apply H14. inversion H7.*) +Admitted. (* ************************************************************************** * @@ -242,7 +290,7 @@ Qed. * NatValue. If the result 'None' is returned, then no such set of key * variables can be determined. *) -Fixpoint keyVariables {ev} {eq} {f} (e : @absExp ev eq f) : option (list id) := +Fixpoint keyVariables (e : absExp) : option (list id) := match e with | (AbsFun (AbsPlusId) (l::r::nil)) => match (keyVariables l,keyVariables r) with @@ -295,7 +343,7 @@ Definition is_key_variable (x : id) (kv : option (list id)) := * 's' is required to be assigned if it is a key variable in either the first expression * of an AbsPredicate or TREE or either the first or second predicate in an AbsCell. *) -Fixpoint basicVarAssigned {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) id : bool := +Fixpoint basicVarAssigned (s : absState) id : bool := match s with | AbsStar s1 s2 => if basicVarAssigned s1 id then true else basicVarAssigned s2 id | AbsExistsT s => basicVarAssigned s id @@ -309,7 +357,7 @@ Fixpoint basicVarAssigned {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) id | _ => false end. -Fixpoint getRoot {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : absState := +Fixpoint getRoot (s : absState) : absState := match s with | AbsExistsT s => getRoot s | _ => s @@ -323,7 +371,7 @@ Fixpoint getRoot {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : absState * TREE, then the variable must be assigned. Note that the something else might * be an AbsQVar which is not covered by keyVariables. *) -Inductive varAssigned {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> id -> Prop := +Inductive varAssigned : absState -> id -> Prop := | VarAssignedBasic : forall s v , basicVarAssigned s v = true -> varAssigned s v | VarAssignedPredicate1 : forall s v xx e a b c yy r, @@ -338,19 +386,19 @@ Hint Constructors varAssigned. * A Valid expression is one in which the VarAssigned predicate holds for * each of the key variables. *) -Definition validExpression {ev} {eq} {f} {t} {ac} - (s : @absState ev eq f t ac) - (e : @absExp ev eq f) := +Definition validExpression + (s : absState) + (e : absExp) := forall x vars, keyVariables e <> None /\ (Some vars = keyVariables e -> In x vars -> varAssigned s x). -Theorem quantifyExp {ev} {eq} {f} : - forall (x : @absExp ev eq f) (e:env) v val ee vars, +Theorem quantifyExp : + forall (x : absExp) (e:env) v val ee vars, val = NatValue (e v) -> - absEval (override e v ee) (val::vars) (quantifyAbsVar x v) = + absEval (override e v ee) (val::vars) (quantifyAbsVar x 0 0 v) = absEval e vars x. Proof. admit. (*intro x. induction x using abs_ind'. @@ -372,19 +420,19 @@ Proof. admit. crunch. unfold quantifyAbsVar. fold (@quantifyAbsVar ev eq f). crunch. rewrite H0. crunch. crunch. apply (NatValue 0).*) -Qed. +Admitted. -Theorem quantifyExpList {ev} {eq} {f} : - forall (l : list (@absExp ev eq f)) (e:env) x v val vars, +Theorem quantifyExpList : + forall (l : list absExp) (e:env) x v val vars, val = NatValue (e v) -> (map (absEval (override e v x) (val::vars)) - (map (fun x0 => quantifyAbsVar x0 v) l))= + (map (fun x0 => quantifyAbsVar x0 0 0 v) l))= (map (absEval e vars) l). Proof. admit. (*induction l. crunch. crunch. erewrite quantifyExp. erewrite IHl. crunch. crunch. crunch.*) -Qed. +Admitted. Theorem mapFirsts {t} : forall rl l v x, @@ -427,10 +475,10 @@ Proof. rewrite H1. crunch. Qed. -Theorem mapProp {ev} : +Theorem mapProp : forall l v x y, In y (map - (fun ss : (@Value ev) * (env * heap) => + (fun ss : (@Value unit) * (env * heap) => (fst ss, (override (fst (snd ss)) v x, snd (snd ss)))) l) -> (exists y', (y = (fst y',(override (fst (snd y')) v x, snd (snd y'))) /\ In y' l)). Proof. @@ -477,10 +525,10 @@ Proof. crunch. Qed. -Theorem quantify1gen {ev} {eq} {f} {t} {ac} : - forall (P : @absState ev eq f t ac) state v x val vars, +Theorem quantify1gen : + forall (P : absState) state v x val vars, val = NatValue (fst state v) -> - realizeState P vars state -> realizeState (quantifyAbsVarState P v) (val::vars) + realizeState P vars state -> realizeState (quantifyAbsVarState P 0 0 v) (val::vars) (override (fst state) v x, snd state). Proof. admit. (*intro P. induction P. @@ -570,23 +618,23 @@ Proof. admit. eapply RSR. crunch. rewrite quantifyExpList. crunch. crunch. crunch. inversion H0.*) -Qed. +Admitted. -Theorem quantify1 {ev} {eq} {f} {t} {ac} : - forall (P : @absState ev eq f t ac) state v x val bindings, +Theorem quantify1 : + forall (P : absState) state v x val bindings, val = NatValue (fst state v) -> - realizeState P bindings state -> realizeState (quantifyAbsVarState P v) (val::bindings) + realizeState P bindings state -> realizeState (quantifyAbsVarState P 0 0 v) (val::bindings) (override (fst state) v x, snd state). Proof. crunch. eapply quantify1gen. crunch. crunch. Qed. -Theorem absEvalSimp {ev} {eq} {f} : forall (e : @absExp ev eq f) n (st : state) v x bindings, +Theorem absEvalSimp : forall (e : absExp) n (st : state) v x bindings, n = fst st v -> (absEval (override (fst st) v x) ((NatValue n)::bindings) - (quantifyAbsVar e v)) = + (quantifyAbsVar e 0 0 v)) = (absEval (fst st) bindings e). -Proof. admit. +Proof. (*induction e using abs_ind'. crunch. @@ -603,13 +651,13 @@ Proof. admit. induction l. crunch. crunch. rewrite IHl. crunch. rewrite H0. crunch. crunch. crunch. crunch. crunch. - rewrite H0. crunch. crunch.*) -Qed. + rewrite H0. crunch. crunch. *) admit. +Admitted. -Theorem absEvalSimp2 {ev} {eq} {f} : forall (e : @absExp ev eq f) (st : state) v x bindings, +Theorem absEvalSimp2 : forall (e : absExp) (st : state) v x bindings, 0 = fst st v -> (absEval (override (fst st) v x) ((NatValue 0)::bindings) - (quantifyAbsVar e v)) = + (quantifyAbsVar e 0 0 v)) = (absEval (fst st) bindings e). Proof. admit. (*induction e using abs_ind'. @@ -633,17 +681,16 @@ Proof. admit. crunch. rewrite IHl. rewrite H1. crunch. crunch. crunch. apply 0. crunch. rewrite H1. crunch. apply 0. crunch.*) -Qed. +Admitted. -Theorem existsEvalDecompose_a {ev} {eq} {f} {t} {ac} {u} : - forall e (a : @absExp ev eq f) a0 i bindings, - supportsBasicFunctionality ev eq f t ac u -> +Theorem existsEvalDecompose_a : + forall e (a : absExp) a0 i bindings, (i = 2 \/ i = 3 \/ i = 4 \/ i = 5 \/ i = 6 \/ i = 7 \/ i = 8) -> (exists x : nat, (absEval e bindings (AbsFun (Id i) (a :: a0 :: nil))) = NatValue x) -> (exists x : nat, (absEval e bindings a)= NatValue x). Proof. - crunch. + (*crunch. unfold supportsBasicFunctionality in H. unfold supportsFunctionality in H. crunch. @@ -660,18 +707,17 @@ Proof. caseAnalysis;inversion H2. caseAnalysis;inversion H2. caseAnalysis;inversion H2. - omega. -Qed. + omega. *) +Admitted. -Theorem existsEvalDecompose_b {ev} {eq} {f} {t} {ac} {u} : - forall e (a : @absExp ev eq f) a0 i bindings, - supportsBasicFunctionality ev eq f t ac u -> +Theorem existsEvalDecompose_b : + forall e (a : absExp) a0 i bindings, (i = 2 \/ i = 3 \/ i = 4 \/ i=5 \/ i=6) -> (exists x : nat, (absEval e bindings (AbsFun (Id i) (a :: a0 :: nil))) = NatValue x) -> (exists x : nat, (absEval e bindings a0)= NatValue x). Proof. - crunch. + (*crunch. unfold supportsBasicFunctionality in H. unfold supportsFunctionality in H. crunch. @@ -696,18 +742,18 @@ Proof. caseAnalysis;inversion H2. caseAnalysis;inversion H2. caseAnalysis;inversion H2. - omega. -Qed. + omega.*) + admit. +Admitted. -Theorem existsEvalDecompose {ev} {eq} {f} {t} {ac} {u} : - forall e (a : @absExp ev eq f) bindings i, - supportsBasicFunctionality ev eq f t ac u -> +Theorem existsEvalDecompose : + forall e (a : absExp) bindings i, (i = 10) -> (exists x : nat, (absEval e bindings (AbsFun (Id i) (a :: nil))) = NatValue x) -> (exists x : nat, (absEval e bindings a)= NatValue x). Proof. - crunch. + (*crunch. unfold supportsBasicFunctionality in H. unfold supportsFunctionality in H. crunch. @@ -719,11 +765,12 @@ Proof. apply ex_intro with (x := n). crunch. inversion H0. inversion H0. inversion H0. - omega. -Qed. + omega.*) + admit. +Admitted. (*Theorem defineWhenKeys {ev} {eq} {f} {t} {ac} {u} : - forall (val : @absExp ev eq f) vars e v bindings, + forall (val : absExp) vars e v bindings, supportsBasicFunctionality ev eq f t ac u -> Some vars = keyVariables val -> In v vars -> @@ -988,12 +1035,12 @@ Qed.*) (* eapply validPickElement. crunch. crunch. crunch. rewrite H2. crunch. crunch. Qed.*) -Theorem validKeyVariablesSubterm {ev} {eq} {f} : - forall ff x l, @keyVariables ev eq f (AbsFun ff l)<>None -> +Theorem validKeyVariablesSubterm : + forall ff x l, keyVariables (AbsFun ff l)<>None -> ff <> AbsMemberId -> ff <> AbsIncludeId -> In x l -> keyVariables x<>None. -Proof. - crunch. +Proof. admit. + (*crunch. destruct ff. destruct n. crunch. destruct n. crunch. destruct n. destruct l. crunch. destruct l. crunch. @@ -1052,16 +1099,16 @@ Proof. destruct l. inversion H2. subst. apply H. crunch. - crunch. crunch. crunch. -Qed. + crunch. crunch. crunch.*) +Admitted. -Theorem keyVariablesSubset {ev} {eq} {f} : +Theorem keyVariablesSubset : forall ff x l v vars1 vars2, In x l -> - @keyVariables ev eq f (AbsFun ff l) = Some vars1 -> + keyVariables (AbsFun ff l) = Some vars1 -> ff <> AbsMemberId -> ff <> AbsIncludeId -> keyVariables x = Some vars2 -> In v vars2 -> In v vars1. -Proof. - crunch. +Proof. admit. + (*crunch. destruct ff. destruct n. crunch. destruct n. crunch. destruct n. destruct l. crunch. destruct l. crunch. destruct l. @@ -1110,29 +1157,29 @@ Proof. destruct n. crunch. destruct l. crunch. destruct l. inversion H. subst. clear H. rewrite H3 in H0. crunch. crunch. crunch. - crunch. crunch. -Qed. + crunch. crunch.*) +Admitted. -Theorem validExpressionProp {ev} {eq} {f} {t} {ac} : - forall (P : @absState ev eq f t ac) i l x, +Theorem validExpressionProp : + forall (P : absState) i l x, In x l -> i<>AbsMemberId -> i<>AbsIncludeId -> - @validExpression ev eq f t ac P (AbsFun i l) -> + validExpression P (AbsFun i l) -> validExpression P x. Proof. - crunch. unfold validExpression in H2. + (*crunch. unfold validExpression in H2. unfold validExpression. intros. split. eapply validKeyVariablesSubterm. - apply H2. apply (Id 0). (*crunch*) apply nil. (*crunch?*) + apply H2. apply (Id 0). crunch apply nil. crunch? crunch. crunch. crunch. remember (keyVariables (AbsFun i l)). destruct o. intros. eapply H2. reflexivity. eapply keyVariablesSubset. crunch. rewrite Heqo. reflexivity. crunch. crunch. rewrite <- H3. reflexivity. crunch. - assert (@None (list id) <> None). eapply H2. apply x0. apply vars. (*crunch*) - elim H3. reflexivity. -Qed. (* Crunch problems *) + assert (@None (list id) <> None). eapply H2. apply x0. apply vars. crunch + elim H3. reflexivity.*) admit. +Admitted. (* Crunch problems *) (*Theorem validHasAssign {ev} {eq} {f} {t} {ac} {u} : forall st v (P: @absState ev eq f t ac) bindings, @@ -1146,7 +1193,7 @@ Proof. unfold keyVariables. crunch. crunch. Qed.*) -Fixpoint noMemberExpression {ev} {eq} {f} (e : @absExp ev eq f) := +Fixpoint noMemberExpression (e : absExp) := match e with | AbsFun x l => (x <> AbsMemberId /\ x <> AbsIncludeId /\ (fold_right (fun x y => x /\ y) True (map noMemberExpression l))) @@ -1168,7 +1215,7 @@ Proof. Qed.*) (*Theorem absEvalSimp2 {ev} {eq} {f} {t} {ac} {u} : - forall y (st : state) v x (e : @absExp ev eq f) + forall y (st : state) v x (e : absExp) (P : @absState ev eq f t ac) bindings, supportsBasicFunctionality ev eq f t ac u -> None = fst st v -> @@ -1198,7 +1245,7 @@ Proof. simpl. - assert (forall (l : list (@absExp ev eq f)), (map (absEval (override (fst st) v x) (y::bindings)) + assert (forall (l : list absExp), (map (absEval (override (fst st) v x) (y::bindings)) (map (fun x0 : absExp => quantifyAbsVar x0 v) l))= (map (fun x0 => absEval (override (fst st) v x) (y::bindings) (quantifyAbsVar x0 v)) l)). crunch. @@ -1211,7 +1258,7 @@ Proof. assert (forall x, In x l -> noMemberExpression x). intros. eapply noMemberPropagate. crunch. crunch. - assert (forall (e : @absExp ev eq f), In e l -> + assert (forall (e : absExp), In e l -> (absEval (override (fst st) v x) (y::bindings) (quantifyAbsVar e v)) = (absEval (fst st) bindings e)). crunch. @@ -1227,7 +1274,7 @@ Proof. induction ll. crunch. - unfold subset. fold (@subset (@absExp ev eq f)). crunch. + unfold subset. fold (@subset absExp). crunch. rewrite H7. rewrite IHll. crunch. crunch. crunch. rewrite H8. reflexivity. @@ -1248,13 +1295,13 @@ Proof. adxmit. Qed.*) -Theorem absEvalAeval {ev} {eq} {f} {t} {ac} {u} : +Theorem absEvalAeval : forall e (st : state) bindings, - supportsBasicFunctionality ev eq f t ac u -> (NatValue (aeval st e)) = - (absEval (fst st) bindings (@convertToAbsExp ev eq f e)). + (absEval (fst st) bindings (convertToAbsExp e)). Proof. - induction e. + admit. + (*induction e. crunch. intros. simpl. reflexivity. @@ -1308,21 +1355,20 @@ Proof. crunch. erewrite H0. 3:reflexivity. erewrite <- IHe. crunch. unfold basicEval. destruct (beq_nat (aeval st e) 0). crunch. crunch. - crunch. crunch. -Qed. + crunch. crunch.*) +Admitted. -Theorem absPredicateCompose {ev} {eq} {f} {t} {ac} {u} : +Theorem absPredicateCompose : forall P p state bindings, - supportsBasicFunctionality ev eq f t ac u -> realizeState P bindings state -> - realizeState (@AbsLeaf ev eq f t ac AbsPredicateId (p::nil)) bindings (fst state,empty_heap) -> - realizeState (@AbsStar ev eq f t ac ([p]) P) bindings state. + realizeState (AbsLeaf AbsPredicateId (p::nil)) bindings (fst state,empty_heap) -> + realizeState (AbsStar ([p]) P) bindings state. Proof. - crunch. inversion H. crunch. inversion H1. subst. eapply H5 in H13. + (*crunch. inversion H. crunch. inversion H1. subst. eapply H5 in H13. 2:crunch. crunch. inversion H13. subst. clear H13. crunch. eapply RSCompose. crunch. crunch. unfold concreteCompose. crunch. - left. unfold empty_heap. crunch. crunch. -Qed. + left. unfold empty_heap. crunch. crunch.*) admit. +Admitted. (*Theorem validExpressionValue {ev} {eq} {f} {t : id -> list (@Value ev) -> heap -> Prop} {ac} {u} : forall e (P : @absState ev eq f t ac) st bindings, @@ -1488,7 +1534,7 @@ Proof. assert (@None (list id) <> None). apply H1. apply (Id 0). apply nil. crunch. Qed.*) -Theorem noMemberTheorem {ev} {eq} {f} : forall e, noMemberExpression (@convertToAbsExp ev eq f e). +Theorem noMemberTheorem : forall e, noMemberExpression (convertToAbsExp e). Proof. induction e. @@ -1503,88 +1549,88 @@ Proof. crunch. intro X. inversion X. intro X. inversion X. Qed. -Theorem validExpressionValue {ev} {eq} {f} {t : id -> list (@Value ev) -> heap -> Prop} {ac} {u} { x : supportsBasicFunctionality ev eq f t ac u } : - forall e env b, exists x, absEval env b (@convertToAbsExp ev eq f e)=@NatValue ev x. +Theorem validExpressionValue : + forall e env b, exists x, absEval env b (convertToAbsExp e)=NatValue x. Proof. - induction e. + (*induction e. intros. eapply ex_intro. simpl. reflexivity. intros. simpl. destruct (env i). eapply ex_intro. reflexivity. eapply ex_intro. reflexivity. intros. simpl. inversion x. erewrite H. 3:reflexivity. 2:omega. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e1) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e1) = NatValue x). eapply IHe1. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e2) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e2) = NatValue x). eapply IHe2. inversion H1. subst. clear H1. inversion H2. subst. clear H2. rewrite H1. rewrite H3. simpl. eapply ex_intro. reflexivity. intros. simpl. inversion x. erewrite H. 3:reflexivity. 2:omega. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e1) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e1) = NatValue x). eapply IHe1. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e2) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e2) = NatValue x). eapply IHe2. inversion H1. subst. clear H1. inversion H2. subst. clear H2. rewrite H1. rewrite H3. simpl. eapply ex_intro. reflexivity. intros. simpl. inversion x. erewrite H. 3:reflexivity. 2:omega. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e1) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e1) = NatValue x). eapply IHe1. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e2) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e2) = NatValue x). eapply IHe2. inversion H1. subst. clear H1. inversion H2. subst. clear H2. rewrite H1. rewrite H3. simpl. eapply ex_intro. reflexivity. intros. simpl. inversion x. erewrite H. 3:reflexivity. 2:omega. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e1) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e1) = NatValue x). eapply IHe1. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e2) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e2) = NatValue x). eapply IHe2. inversion H1. subst. clear H1. inversion H2. subst. clear H2. rewrite H1. rewrite H3. simpl. unfold basicEval. remember (beq_nat x0 x1). destruct b0. eapply ex_intro. reflexivity. eapply ex_intro. reflexivity. intros. simpl. inversion x. erewrite H. 3:reflexivity. 2:omega. erewrite H. 3:reflexivity. 2:omega. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e1) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e1) = NatValue x). eapply IHe1. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e2) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e2) = NatValue x). eapply IHe2. inversion H1. subst. clear H1. inversion H2. subst. clear H2. rewrite H1. rewrite H3. simpl. unfold basicEval. remember (ble_nat x0 x1). destruct b0. simpl. eapply ex_intro. reflexivity. simpl. eapply ex_intro. reflexivity. intros. simpl. inversion x. erewrite H. 3:reflexivity. 2:omega. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e1) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e1) = NatValue x). eapply IHe1. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e2) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e2) = NatValue x). eapply IHe2. inversion H1. subst. clear H1. inversion H2. subst. clear H2. rewrite H1. rewrite H3. simpl. unfold basicEval. remember (beq_nat x0 0). destruct b0. simpl. eapply ex_intro. reflexivity. simpl. eapply ex_intro. reflexivity. intros. simpl. inversion x. erewrite H. 3:reflexivity. 2:omega. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e1) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e1) = NatValue x). eapply IHe1. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e2) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e2) = NatValue x). eapply IHe2. inversion H1. subst. clear H1. inversion H2. subst. clear H2. rewrite H1. rewrite H3. simpl. unfold basicEval. remember (beq_nat x0 0). destruct b0. simpl. eapply ex_intro. reflexivity. simpl. eapply ex_intro. reflexivity. intros. simpl. inversion x. erewrite H. 3:reflexivity. 2:omega. - assert (exists x : nat, absEval env b (@convertToAbsExp ev eq f e) = NatValue x). + assert (exists x : nat, absEval env b (convertToAbsExp e) = NatValue x). eapply IHe. inversion H1. subst. clear H1. rewrite H2. simpl. unfold basicEval. remember (beq_nat x0 0). destruct b0. - simpl. eapply ex_intro. reflexivity. simpl. eapply ex_intro. reflexivity. -Qed. + simpl. eapply ex_intro. reflexivity. simpl. eapply ex_intro. reflexivity.*) + admit. +Admitted. -Theorem assign {ev} {eq} {f} {t : id -> list (@Value ev) -> heap -> Prop} {ac} {u} - { x : supportsBasicFunctionality ev eq f t ac u } : +Theorem assign : forall P v e Q, - Q = (@AbsUpdateVar ev eq f t ac P v (convertToAbsExp e)) -> - {{ P }} v ::= e {{ Q , NoResult }}. + Q = (AbsUpdateVar P v (convertToAbsExp e)) -> + {{ P }} v ::= e {{ Q return (#0::nil) with AbsNone }}. Proof. admit. (*crunch. unfold hoare_triple. unfold absExecute. crunch. eapply ex_intro. eapply ex_intro. @@ -1640,12 +1686,12 @@ Proof. admit. crunch. crunch. Grab Existential Variables. apply x. *) -Qed. +Admitted. Definition id_fun {e} := fun (x:e) => x. -Theorem sbasic1 : +(*Theorem sbasic1 : forall x, convertAbsValue (fun _ : unit => tt) x=x. Proof. intros. induction x using value_ind'. simpl. reflexivity. simpl. reflexivity. simpl. destruct v. reflexivity. @@ -1662,7 +1708,7 @@ Proof. induction l. simpl. reflexivity. Qed. Theorem sbasic3 : - forall c (e:@absExp unit eq_unit c), (@convertAbsExp unit eq_unit c unit eq_unit c (fun _ : unit => tt) e)=e. + forall c (e:absExp), (convertAbsExp e)=e. Proof. intros. induction e using abs_ind'. unfold convertAbsExp. rewrite sbasic1. reflexivity. @@ -1672,9 +1718,9 @@ Proof. induction l. simpl. reflexivity. simpl. simpl in H. inversion H. rewrite H0. rewrite IHl. reflexivity. apply H1. rewrite H0. reflexivity. -Qed. +Qed.*) -Theorem sbasic : supportsBasicFunctionality unit eq_unit unitEval basicState (@basicAccumulate unit eq_unit unitEval) tt. +(*Theorem sbasic : supportsBasicFunctionality unit eq_unit unitEval basicState (@basicAccumulate unit eq_unit unitEval) tt. Proof. unfold supportsBasicFunctionality. unfold supportsFunctionality. split. intros. unfold unitEval. rewrite sbasic2 in H0. subst. rewrite sbasic1. reflexivity. @@ -1682,12 +1728,12 @@ Proof. split. intros. rewrite sbasic2 in H0. subst. apply H. split. intros. rewrite sbasic2 in H0. subst. apply H. split. intros. rewrite sbasic2. rewrite sbasic2. rewrite sbasic1. rewrite sbasic3. apply H. - intros. rewrite sbasic2. rewrite sbasic2. rewrite sbasic1. rewrite sbasic3. apply H. -Qed. + intros. rewrite sbasic2. rewrite sbasic2. rewrite sbasic1. rewrite sbasic3. apply H. admit. +Admitted.*) -Hint Resolve sbasic. +(*Hint Resolve sbasic.*) -Definition basicAssign := @assign unit eq_unit unitEval basicState basicAccumulate tt. +(*Definition basicAssign := @assign unit eq_unit unitEval basicState basicAccumulate tt.*) (* ************************************************************************** * @@ -1695,66 +1741,77 @@ Definition basicAssign := @assign unit eq_unit unitEval basicState basicAccumula * ****************************************************************************) -Fixpoint add_cells {ev} {eq} {f} {t} {ac} (n : nat) (base : absState) : absState := +Fixpoint add_cells (n : nat) (base : absState) : absState := match n with | 0 => base - | (S n1) => (@AbsStar ev eq f t ac (v(0)++++#n1 |-> v(n)) (add_cells n1 base)) + | (S n1) => (AbsStar (v(0)++++#n1 |-> v(n)) (add_cells n1 base)) end. -Fixpoint n_quant {ev} {eq} {f} {t} {ac} (n : nat) (s : absState) : @absState ev eq f t ac := +Fixpoint n_quant (n : nat) (s : absState) : absState := match n with | 0 => s - | (S n1) => n_quant n1 (@AbsExistsT ev eq f t ac s) + | (S n1) => n_quant n1 (AbsExistsT s) end. -Fixpoint pushNState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (n : nat) := +Fixpoint pushNState (s : absState) (n : nat) := match n with | 0 => s - | S n1 => pushNState (pushAbsVarState s) n1 + | S n1 => pushNState (addStateVar 0 s) n1 end. -Theorem new_thm {ev} {eq} {f} {t} {ac} : forall P v size Q, - Q = n_quant (S size) (add_cells size - (@AbsStar ev eq f t ac ([!!v====v(0)]) - (pushNState (AbsExistsT (quantifyAbsVarState P v)) (S size)))) -> - {{ P }} (NEW v,(ANum size)) {{ Q , NoResult }}. +Theorem new_thm : forall P v size Q, + Q = n_quant (S size) (AbsExistsT (add_cells size + (AbsStar ([!!v====v(0)]) + (quantifyAbsVarState (pushNState P (S size)) 1 0 v)))) -> + {{ P }} (NEW v,(ANum size)) {{ Q return (#0::nil) with AbsNone }}. +Proof. + admit. Admitted. Ltac new_thm := eapply new_thm;simpl;reflexivity. +Theorem del_thm : forall P v size Q vv, + vv = convertToAbsExp v -> + Q = AbsMagicWand P (n_quant (S size) (add_cells size ([vv====v(0)]))) -> + ((exists s, realizeState P nil s) -> (exists s, realizeState Q nil s)) -> + {{ P }} (DELETE v,(ANum size)) {{ Q return (#0::nil) with AbsNone }}. +Proof. admit. Admitted. + +Ltac del_thm := + eapply del_thm;simpl;reflexivity. + + (* ************************************************************************** * * Theorems and definitions for store * ****************************************************************************) -Fixpoint replaceRoot {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (r : @absState ev eq f t ac) : absState := +Fixpoint replaceRoot (s : absState) (r : absState) : absState := match s with | AbsExistsT s => AbsExistsT (replaceRoot s r) | _ => r end. -Fixpoint rootCount {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : nat := +Fixpoint rootCount (s : absState) : nat := match s with | AbsExistsT s => S(rootCount s) | _ => 0 end. -Theorem store {ev} {eq} {f} {t} {ac} : forall P r r' x ll l v Q, - - r = getRoot P -> +Theorem store : forall P ll l v vv, ll = (convertToAbsExp l) -> - spickElement r (ll |-> x) r' -> - Q = replaceRoot P (@AbsStar ev eq f t ac (ll |-> (convertToAbsExp v)) r') -> - {{ P }} CStore l v {{ Q , NoResult }}. -Proof. admit. Qed. + vv = convertToAbsExp v -> + (forall s n, realizeState P nil s -> ((NatValue n)=(absEval (env_p s) nil ll) -> (heap_p s) n<>None)) -> + {{ P }} CStore l v {{ (AbsUpdateLoc P ll vv) return (#0::nil) with AbsNone }}. +Proof. admit. Admitted. Ltac store := eapply store; [(simpl;reflexivity)|(simpl;reflexivity)|solveSPickElement| (simpl;reflexivity)]. -Theorem store_array {ev} {eq} {f} {t} {ac} : forall P r r' (bb : @absExp ev eq f) base ll l v vv var Q size c bb, +Theorem store_array : forall P r r' (bb : absExp) base ll l v vv var Q size c bb, r = getRoot P -> c = rootCount P -> ll = convertToAbsExp l -> @@ -1762,9 +1819,9 @@ Theorem store_array {ev} {eq} {f} {t} {ac} : forall P r r' (bb : @absExp ev eq f vv = convertToAbsExp v -> spickElement r (ARRAY(bb, size, (AbsQVar var))) r' -> (forall ss, realizeState P nil ss -> absEval (fst ss) nil (ll <<<< size)=NatValue 1) -> - Q = (AbsExistsT (replaceRoot P (@AbsLeaf ev eq f t ac (Id 4) ((pushAbsVar bb)::(pushAbsVar size)::(AbsQVar (var+1))::nil) ** (@AbsLeaf ev eq f t ac (Id 1) ((vv====(nth(AbsQVar (var+1),(pushAbsVar ll))))::nil)) ** (replaceStateExp (AbsQVar (var+1)) (replacenth(AbsQVar (var+1),(pushAbsVar ll),(@AbsQVar ev eq f 0))) (pushAbsVarState r'))))) -> - {{ P }} CStore (base+++l) v {{ Q, NoResult }}. -Proof. admit. Qed. + Q = (AbsExistsT (replaceRoot P (AbsLeaf (Id 4) ((addExpVar 0 bb)::(addExpVar 0 size)::(AbsQVar (var+1))::nil) ** (AbsLeaf (Id 1) ((vv====(nth(AbsQVar (var+1),(addExpVar 0 ll))))::nil)) ** (replaceStateExp (AbsQVar (var+1)) (replacenth(AbsQVar (var+1),(addExpVar 0 ll),(AbsQVar 0))) (addStateVar 0 r'))))) -> + {{ P }} CStore (base+++l) v {{ Q return (#0::nil) with AbsNone }}. +Proof. admit. Admitted. (* ************************************************************************** * @@ -1772,26 +1829,77 @@ Proof. admit. Qed. * ****************************************************************************) +Inductive UnfContext := + | UnfCExistsT : UnfContext + | UnfCUpdateVar : id -> absExp -> UnfContext + | UnfCUpdateWithLoc : id -> absExp -> UnfContext + | UnfCUpdateLoc : absExp -> absExp -> UnfContext + | UnfCMagicWand : absState -> UnfContext + | UnfCStar : absState -> UnfContext + . + +Fixpoint getRootTraceLoadTraverse (e:absExp) (s : absState) : option (absState * list UnfContext) := + match s with + | AbsExistsT s => match getRootTraceLoadTraverse e s with + | Some (s,l) => Some (s,(UnfCExistsT::l)) + | None => None + end + | AbsUpdateVar s i v => if hasVarExp e i then None + else match getRootTraceLoadTraverse e s with + | Some (s,l) => Some (s,((UnfCUpdateVar i v)::l)) + | None => None + end + | AbsUpdateWithLoc s i v => if hasVarExp e i then None + else match getRootTraceLoadTraverse e s with + | Some (s,l) => Some (s,((UnfCUpdateWithLoc i v)::l)) + | None => None + end + | AbsStar x y => match x,y with + | ([a]),b => match getRootTraceLoadTraverse e b with + | Some (s,l) => Some (s,(UnfCStar ([a]))::l) + | None => None + end + | b,([a]) => match getRootTraceLoadTraverse e b with + | Some (s,l) => Some (s,(UnfCStar ([a]))::l) + | None => None + end + | _,_ => Some (s,nil) + end + | AbsUpdateLoc s i v => None + (*| AbsMagicWand a b => (UnfCMagicWand b)::(getUnfoldTrace a)*) + | _ => Some (s,nil) + end. + +Fixpoint finishState (s : absState) (l : list (UnfContext)) := + match l with + | UnfCExistsT::r => AbsExistsT (finishState s r) + | (UnfCUpdateVar i v)::r => (AbsUpdateVar (finishState s r) i v) + | (UnfCUpdateWithLoc i v)::r => AbsUpdateWithLoc (finishState s r) i v + | (UnfCUpdateLoc i v)::r => AbsUpdateLoc (finishState s r) i v + | (UnfCMagicWand d)::r => AbsMagicWand (finishState s r) d + | (UnfCStar x)::r => AbsStar (finishState s r) (x) + | nil => s + end. (* * This theorem creates a tactic that allows one to retain an inTree relationship after * an operation that causes one to traverse a pointer to a child node in a TREE type * data structure. See the proof of loopInvariant for an example of this rule's use. *) -Theorem load_traverse {ev} {eq} {f} {t} {ac} : forall v (r:@absState ev eq f t ac) r' r'' ff vve vv (PPP:@absState ev eq f t ac) Q root heap size fields, +Theorem load_traverse : forall v (r:absState) r' r'' ff vve vv (PPP:absState) Q t root heap size fields, vv = convertToAbsExp vve -> - r = getRoot PPP -> + Some (r,t) = getRootTraceLoadTraverse (AbsVar v) PPP -> spickElement r ([vv inTree heap]) r' -> spickElement r' (TREE(root,heap,size,fields)) r'' -> - Q = @AbsExistsT ev eq f t ac - (@replaceRoot ev eq f t ac PPP - (@AbsStar ev eq f t ac + Q = AbsExistsT + (finishState + (AbsStar ([(!!v)====#0 \\// - (!!v) inTree (quantifyAbsVar heap v)]) + (!!v) inTree (quantifyAbsVar (addExpVar 0 heap) 0 0 v)]) (AbsStar - ([nth(nth(quantifyAbsVar (find(heap,vv)) v,#(ff+1)),#0)====(@AbsVar ev eq f v)]) - (quantifyAbsVarState r v)))) -> - {{ PPP }} CLoad v (APlus vve (ANum ff)) {{ Q, NoResult }}. -Proof. admit. Qed. + ([nth(nth(quantifyAbsVar (find((addExpVar 0 heap),vv)) 0 0 v,#(ff+1)),#0)====(AbsVar v)]) + (quantifyAbsVarState r 0 0 v))) t) -> + {{ PPP }} CLoad v (APlus vve (ANum ff)) {{ Q return (#0::nil) with AbsNone }}. +Proof. admit. Admitted. Ltac load_traverse := eapply load_traverse;[ (simpl; reflexivity) | @@ -1800,7 +1908,7 @@ Ltac load_traverse := eapply load_traverse;[ solveSPickElement | (simpl; reflexivity)]. -Fixpoint findCell {ev} {eq} {f} {t} {ac} (state : @absState ev eq f t ac) (loc : @absExp ev eq f) := +Fixpoint findCell (state : absState) (loc : absExp) := match state with | AbsLeaf i (l::val::nil) => if beq_id i AbsCellId && beq_absExp l loc then Some val else None | AbsStar l r => match findCell l loc with @@ -1815,28 +1923,31 @@ Fixpoint findCell {ev} {eq} {f} {t} {ac} (state : @absState ev eq f t ac) (loc : * cell value into a variable. See the loopInvariant proof in TreeTraversal.v for an * example of this rule's use. *) -Theorem load {ev} {eq} {f} {t} {ac} : forall (P:@absState ev eq f t ac) v loc (Q:@absState ev eq f t ac) e r, - - r = getRoot P -> - Some e = findCell r (@convertToAbsExp ev eq f loc) -> - Q = (AbsExistsT (replaceRoot P (AbsStar - ([(!!v)====(quantifyAbsVar e v)]) - (quantifyAbsVarState r v)))) -> - {{ P }} CLoad v loc {{ Q , NoResult }}. -Proof. admit. Qed. +Theorem load : forall (P:absState) v loc ll, + ll = (convertToAbsExp loc) -> + {{ P }} CLoad v loc {{ (AbsUpdateWithLoc P v ll) return (#0::nil) with AbsNone }}. +Proof. admit. Admitted. + +Theorem loadUpdateProp : forall (P:absState) v loc (Q:absState) vv val, + v<>vv -> + {{ P }} CLoad v loc {{ Q return (#0::nil) with AbsNone }} -> + {{ (AbsUpdateVar P vv val) }} CLoad v loc {{ (AbsUpdateVar Q vv val) return (#0::nil) with AbsNone }}. +Proof. + admit. +Admitted. -Theorem load_array {ev} {eq} {f} {t} {ac} : forall P r r' (bb : @absExp ev eq f) base ll l v var Q size c bb, +Theorem load_array : forall P r r' (bb : absExp) base ll l v var Q size c bb, r = getRoot P -> c = rootCount P -> ll = convertToAbsExp l -> bb = convertToAbsExp base -> - spickElement r (@AbsLeaf ev eq f t ac (Id 4) (bb::size::(@AbsQVar ev eq f var)::nil)) r' -> - (forall ss, realizeState P nil ss -> absEval (fst ss) nil (ll <<<< size)=@NatValue ev 1) -> + spickElement r (AbsLeaf (Id 4) (bb::size::(AbsQVar var)::nil)) r' -> + (forall ss, realizeState P nil ss -> absEval (fst ss) nil (ll <<<< size)=@NatValue unit 1) -> Q = (AbsExistsT (replaceRoot P (AbsStar - ([(!!v)====(quantifyAbsVar (nth((@AbsQVar ev eq f var),ll)) v)]) - (quantifyAbsVarState r v)))) -> - {{ P }} CLoad v (base+++l) {{ Q, NoResult }}. -Proof. admit. Qed. + ([(!!v)====(quantifyAbsVar (nth((AbsQVar var),ll)) 0 0 v)]) + (quantifyAbsVarState r 0 0 v)))) -> + {{ P }} CLoad v (base+++l) {{ Q return (#0::nil) with AbsNone }}. +Proof. admit. Admitted. (* ************************************************************************** * @@ -1844,7 +1955,7 @@ Proof. admit. Qed. * ****************************************************************************) -Fixpoint removeCell {ev} {eq} {f} {t} {ac} (state : @absState ev eq f t ac) (loc : @absExp ev eq f) := +Fixpoint removeCell (state : absState) (loc : absExp) := match state with | AbsLeaf i (l::val::nil) => if beq_id AbsCellId i && beq_absExp l loc then Some AbsEmpty else None | AbsExistsT s => match removeCell s loc with @@ -1861,7 +1972,7 @@ Fixpoint removeCell {ev} {eq} {f} {t} {ac} (state : @absState ev eq f t ac) (loc | _ => None end. -Fixpoint removeCells {ev} {eq} {f} {t} {ac} (state : @absState ev eq f t ac) (loc : @absExp ev eq f) (n : nat) := +Fixpoint removeCells (state : absState) (loc : absExp) (n : nat) := match n with | 0 => Some state | S 0 => match removeCell state loc with @@ -1878,20 +1989,19 @@ Fixpoint removeCells {ev} {eq} {f} {t} {ac} (state : @absState ev eq f t ac) (lo * This is the rule for forward propagating over a DELETE statement. See loopInvariant * in TreeTraversal.v for an example of this rule's use. *) -Theorem delete_thm {ev} {eq} {f} {t : id -> list (@Value ev) -> heap -> Prop} {ac} {u} - { x : supportsBasicFunctionality ev eq f t ac u } : - forall (P:@absState ev eq f t ac) v (loc:@absExp ev eq f) (Q:@absState ev eq f t ac) n exp nn, +Theorem delete_thm : + forall (P:absState) v (loc:absExp) (Q:absState) n exp nn, - loc = convertAbsExp (fun x => u) (@convertToAbsExp unit eq_unit unitEval v) -> - AbsConstVal n = @convertAbsExp unit eq_unit basicEval ev eq f (fun x => u) (@convertToAbsExp unit eq_unit unitEval exp) -> + loc = convertAbsExp (convertToAbsExp v) -> + AbsConstVal n = convertAbsExp (convertToAbsExp exp) -> Some Q = removeCells P loc nn -> n = NatValue nn -> - {{ P }} DELETE v,exp {{ Q , NoResult }}. -Proof. admit. Qed. + {{ P }} DELETE v,exp {{ Q return (#0::nil) with AbsNone }}. +Proof. admit. Admitted. -Definition delete_thm_basic := @delete_thm unit eq_unit +(*Definition delete_thm_basic := @delete_thm unit eq_unit (@basicEval unit) - (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) tt. + (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) tt.*) (* ************************************************************************** * @@ -1904,8 +2014,9 @@ Theorem cevalFalse : forall f r st st' b1 c1 c2, ceval f st (CIf b1 c1 c2) st' r -> ceval f st c2 st' r. Proof. - intros. inversion H0. subst. rewrite H in H8. elim H8. reflexivity. subst. apply H9. -Qed. + admit. + (*intros. inversion H0. subst. rewrite H in H8. elim H8. reflexivity. subst. apply H9.*) +Admitted. Theorem cevalTrue : forall f r st st' b1 c1 c2, aeval st b1 <> 0 -> @@ -1918,21 +2029,21 @@ Qed. (* * mergeStates specifies where states need to be merged at the end of processing an if-then-else *) -Definition mergeStates {ev} {eq} {f} {t} {ac} (Q1 : @absState ev eq f t ac) (Q2 : @absState ev eq f t ac) (Q : @absState ev eq f t ac) := +Definition mergeStates(Q1 : absState) (Q2 : absState) (Q : absState) := (forall s, realizeState Q1 nil s -> realizeState Q nil s) /\ (forall s, realizeState Q2 nil s -> realizeState Q nil s). (* * Rule for propagating over an if-then-else *) -Theorem if_statement {ev} {eq} {f} {t} {ac} {u} : forall (P:@absState ev eq f t ac) Q1 Q2 Q b l r res, - supportsBasicFunctionality ev eq f t ac u -> - {{(AbsStar ([convertToAbsExp b]) P)}}l{{Q1,res}} -> - {{(AbsStar ([~~(convertToAbsExp b)]) P)}}r{{Q2,res}} -> +Theorem if_statement: forall (P:absState) Q1 Q2 Q Q1' Q2' Qm r1 r2 rm b l r, + {{(AbsStar ([convertToAbsExp b]) P)}}l{{Q1 return r1 with Q1' }} -> + {{(AbsStar ([~~(convertToAbsExp b)]) P)}}r{{Q2 return r2 with Q2' }} -> + mergeReturnStates Q1' Q2' Qm r1 r2 rm -> mergeStates Q1 Q2 Q -> - {{P}}CIf b l r{{Q,res}}. -Proof. - unfold hoare_triple. unfold mergeStates. unfold absExecute. intros. inversion H2. subst. clear H2. + {{P}}CIf b l r{{Q return rm with Qm}}. +Proof. admit. + (*unfold hoare_triple. unfold mergeStates. unfold absExecute. intros. inversion H2. subst. clear H2. assert (forall (st st' : state), realizeState ([convertToAbsExp b] ** P) nil st -> (exists (st'0:state) (r:result), @@ -2123,8 +2234,8 @@ Proof. eapply functional_extensionality. reflexivity. eapply cevalTrue. instantiate (1 := b). erewrite <- Heqn. intro X. inversion X. - eapply H9. -Qed. + eapply H9.*) +Admitted. (* ************************************************************************** * @@ -2133,8 +2244,7 @@ Qed. ****************************************************************************) -Theorem while_aux {ev} {eq} {f} {t} {ac} {u} : forall c b ff (invariant: @absState ev eq f t ac) res c1 st1 st1', - supportsBasicFunctionality ev eq f t ac u -> +Theorem while_aux : forall c b ff (invariant: absState) res c1 st1 st1', (forall st st' res, realizeState (AbsStar ([convertToAbsExp b]) invariant) nil st -> ceval ff st c st' res -> realizeState invariant nil st') -> @@ -2143,7 +2253,7 @@ Theorem while_aux {ev} {eq} {f} {t} {ac} {u} : forall c b ff (invariant: @absSta ceval ff st1 c1 st1' res -> realizeState (AbsStar (match res with | NoResult => [~~(convertToAbsExp b)] | _ => AbsEmpty end) invariant) nil st1'. Proof. - intros. induction H3. + admit. (*intros. induction H3. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. subst. clear H2. @@ -2228,18 +2338,17 @@ Proof. unfold compose_heaps. simpl. apply functional_extensionality. intros. reflexivity. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. - inversion H2. -Qed. + inversion H2.*) +Admitted. -Theorem while_aux2 {ev} {eq} {f} {t} {ac} {u} : forall c b ff (invariant: @absState ev eq f t ac) c1 st1, - supportsBasicFunctionality ev eq f t ac u -> +Theorem while_aux2 : forall c b ff (invariant: absState) c1 st1, (forall st, exists st', exists res, realizeState (AbsStar ([convertToAbsExp b]) invariant) nil st -> ceval ff st c st' res -> realizeState invariant nil st') -> realizeState invariant nil st1 -> c1 = (WHILE b DO c LOOP) -> (exists st'', exists res', ceval ff st1 c1 st'' res'). -Proof. admit. Qed. +Proof. admit. Admitted. (* intros. eapply ex_intro. eapply ex_intro. induction H1. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. inversion H2. @@ -2253,11 +2362,10 @@ Proof. admit. Qed. * Rule for propagating over a while. When creating a proof, one will usually have to * fill in the expression 'invariant'. *) -Theorem while {ev} {eq} {f} {t} {ac} {u} : forall (state: @absState ev eq f t ac) c b invariant res, - supportsBasicFunctionality ev eq f t ac u -> - (exists res1, {{AbsStar ([convertToAbsExp b]) invariant}} c {{invariant,res1}}) -> +Theorem whileThm : forall (state: absState) c b invariant res Q, + {{AbsStar ([convertToAbsExp b]) invariant}} c {{invariant return res with Q}} -> (forall x, realizeState state nil x -> realizeState invariant nil x) -> - {{state}} (WHILE b DO c LOOP) {{AbsStar (match res with | NoResult => [~~(convertToAbsExp b)] | _ => AbsEmpty end) invariant,res}}. + {{state}} (WHILE b DO c LOOP) {{ (AbsStar ([~~(convertToAbsExp b)]) invariant) return res with Q}}. Proof. admit. (*unfold hoare_triple. unfold absExecute. intros. @@ -2309,7 +2417,89 @@ Proof. admit. apply H1. apply H2. reflexivity. Grab Existential Variables. apply NoResult.*) -Qed. +Admitted. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/AbsState.v b/PEDANTIC/AbsState.v index 76a9874..d96c1c7 100644 --- a/PEDANTIC/AbsState.v +++ b/PEDANTIC/AbsState.v @@ -96,7 +96,7 @@ Definition absHeap h hpred := (fun (x : state) => (h = (snd x) /\ hpred (snd x) Definition bind {ev} := nat -> option ev. -Definition evType := fst. +(*Definition evType := fst.*) (* Value is the type used for the values returned when evaluating an absExp *) Inductive Value {ev} : Type := @@ -112,9 +112,9 @@ Inductive Value {ev} : Type := * f - a function defining the semantics of AbsFun--this usually includes definitions for * many basic operators such as addition *) -Inductive absExp {ev} {eq : ev -> ev -> bool} - { f : id -> list (@Value ev) -> (@Value ev) } : Type := - | AbsConstVal : (@Value ev) -> absExp +Inductive absExp (*{ev} {eq : ev -> ev -> bool} + { f : id -> list (@Value ev) -> (@Value ev) }*) : Type := + | AbsConstVal : (@Value unit) -> absExp | AbsVar : id -> absExp | AbsQVar : absVar -> absExp | AbsFun : id -> list absExp -> absExp. @@ -130,37 +130,37 @@ Fixpoint All {T} (P : T -> Prop) (ls : list T) : Prop := | (h::t) => P h /\ All P t end. -Fixpoint abs_ind' {ev} {eq : ev -> ev -> bool} { f : id -> list (@Value ev) -> (@Value ev) } - (P : @absExp ev eq f -> Prop) +Fixpoint abs_ind' (*{ev} {eq : ev -> ev -> bool} { f : id -> list (@Value ev) -> (@Value ev) }*) + (P : absExp -> Prop) (cbase : forall c, P (AbsConstVal c)) (vbase : forall id, P (AbsVar id)) (qbase : forall v, P (AbsQVar v)) (ff : forall id l, (All P l) -> P (AbsFun id l)) - (e : @absExp ev eq f) : P e := + (e : absExp) : P e := match e with | (AbsConstVal c) => cbase c | (AbsVar i) => vbase i | (AbsQVar v) => qbase v | (AbsFun i l) => ff i l - ((fix go (ll : list (@absExp ev eq f)) : All P ll := match ll return All P ll with + ((fix go (ll : list absExp) : All P ll := match ll return All P ll with | (fff::r) => conj (abs_ind' P cbase vbase qbase ff fff) (go r) | nil => I end) l) end. -Fixpoint value_ind' {ev} - (P : @Value ev -> Prop) +Fixpoint value_ind' (*{ev}*) + (P : @Value unit -> Prop) (nabase : forall c, P (NatValue c)) (nobase : P NoValue) (obase : forall v, P (OtherValue v)) (ff : forall l, (All P l) -> P (ListValue l)) - (e : @Value ev) : P e := + (e : @Value unit) : P e := match e with | (NatValue n) => nabase n | NoValue => nobase | (OtherValue v) => obase v | (ListValue l) => ff l - ((fix go (ll : list (@Value ev)) : All P ll := match ll return All P ll with + ((fix go (ll : list (@Value unit)) : All P ll := match ll return All P ll with | (fff::r) => conj (value_ind' P nabase nobase obase ff fff) (go r) | nil => I end) l) @@ -189,18 +189,18 @@ Definition beq_list {A} (f : A -> A -> bool) : list A -> list A -> bool := | _, _ => false end. -Fixpoint beq_val {t} {eq} (e1 : @Value t) (e2 : @Value t) : bool := +Fixpoint beq_val (*{t} {eq}*) (e1 : @Value unit) (e2 : @Value unit) : bool := match (e1,e2) with | (NatValue v1,NatValue v2) => beq_nat v1 v2 - | (ListValue l1,ListValue l2) => beq_list (@beq_val t eq) l1 l2 + | (ListValue l1,ListValue l2) => beq_list (beq_val) l1 l2 | (NoValue,NoValue) => true - | (OtherValue v1,OtherValue v2) => eq v1 v2 + | (OtherValue v1,OtherValue v2) => true | _ => false end. -Fixpoint beq_absExp {ev} {eq} {x} (e1 : @absExp ev eq x) (e2 : @absExp ev eq x) : bool := +Fixpoint beq_absExp (*{ev} {eq} {x}*) (e1 : absExp) (e2 : absExp) : bool := match e1 with - | (AbsConstVal v) => match e2 with (AbsConstVal v2) => @beq_val ev eq v v2 | _ => false end + | (AbsConstVal v) => match e2 with (AbsConstVal v2) => beq_val v v2 | _ => false end | (AbsQVar v) => match e2 with (AbsQVar v2) => beq_nat v v2 | _ => false end | (AbsVar v) => match e2 with (AbsVar v2) => beq_id v v2 | _ => false end | (AbsFun id1 l1) => match e2 with @@ -213,6 +213,7 @@ Fixpoint beq_absExp {ev} {eq} {x} (e1 : @absExp ev eq x) (e2 : @absExp ev eq x) Notation "'!!' x" :=(AbsVar x) (at level 1). Notation "'v(' n ')'" := (AbsQVar n) (at level 1). + Notation "'#' n" := (AbsConstVal (NatValue n)) (at level 1). @@ -222,6 +223,142 @@ Inductive strip_option {x} : list (option x) -> list x -> Prop := strip_option r r' -> strip_option ((Some f)::r) (f::r'). +(*************************************************************************** + * + * basicEval + * + * This is used to fill in the 'f' parameter in absExp. + * + ***************************************************************************) + +Notation "'AbsNthId'" := (Id 1) (at level 1). +Notation "'AbsPlusId'" := (Id 2) (at level 1). +Notation "'AbsMinusId'" := (Id 3) (at level 1). +Notation "'AbsTimesId'" := (Id 4) (at level 1). +Notation "'AbsEqualId'" := (Id 5) (at level 1). +Notation "'AbsLessId'" := (Id 6) (at level 1). +Notation "'AbsMemberId'" := (Id 7) (at level 1). +Notation "'AbsIncludeId'" := (Id 8) (at level 1). +Notation "'AbsImplyId'" := (Id 9) (at level 1). +Notation "'AbsNotId'" := (Id 10) (at level 1). +Notation "'AbsAndId'" := (Id 11) (at level 1). +Notation "'AbsOrId'" := (Id 12) (at level 1). +Notation "'AbsIteId'" := (Id 13) (at level 1). +Notation "'AbsFindId'" := (Id 14) (at level 1). +Notation "'AbsListId'" := (Id 15) (at level 1). +Notation "'AbsRangeSetId'" := (Id 16) (at level 1). +Notation "'AbsRangeNumericId'" := (Id 17) (at level 1). +Notation "'AbsReplaceNthId'" := (Id 18) (at level 1). + +Fixpoint rangeSet {t} (v : @Value t) : @Value t := + match v with + | (ListValue (NatValue loc::r)) => + (fix go (x : (list (@Value t))) := + match x with + | (f::l) => match (rangeSet f,go l) with + | ((ListValue l),(ListValue y)) => (ListValue (l++y)) + | _ => NoValue + end + | _ => (ListValue nil) + end) r + | (NatValue _) => (ListValue nil) + | _ => NoValue + end. + +Fixpoint numericRange {t} (s : nat) (e : nat) : @Value t := + if beq_nat s e then (ListValue nil) + else match e with + | 0 => (ListValue (nil)) + | (S e') => match numericRange s e' with + (ListValue l) => (ListValue (l++((NatValue e')::nil))) + | _ => NoValue + end + end. + +Fixpoint replacenth {t} (l : list t) (n : nat) (e : t) := + match l,n with + | (f::r),0 => (e::r) + | (f::r),(S n1) => (f::(replacenth r n1 e)) + | l,_ => l + end. + +Fixpoint flatten {t} (v : @Value t) (loc : nat) : list ((@Value t) * nat) := + match v with + | (ListValue ((NatValue loc)::ll)) => + (v,loc)::((fix go (x : list (@Value t)) l := + match x with + | (f::r) => (flatten f l)++(go r (l+1)) + | _ => nil + end) ll loc) + | x => (v,loc)::nil + end. + +Fixpoint rmemberFullList {t} (n : nat) (v : (list ((@Value t) * nat))) : bool := + match v with + | ((val,loc)::r) => if beq_nat loc n then true else rmemberFullList n r + | _ => false + end. + +Fixpoint rmemberList {t} (n : nat) (v : (list ((@Value t) * nat))) : bool := + match v with + | ((ListValue ((NatValue xx)::ll),loc)::r) => if beq_nat loc n then true else rmemberList n r + | (_::r) => rmemberList n r + | _ => false + end. +Definition Rmember {t} (l : nat) (tree : @Value t) : bool := + rmemberList l (flatten tree 0). + +Definition Rinclude {t} (l : nat) (tree : @Value t) : bool := + rmemberFullList l (flatten tree 0). + +Fixpoint findRecord {t} (l : nat) (v : @Value t) := + match v with + | (ListValue ((NatValue x)::r)) => + if beq_nat x l then + ((NatValue x)::r) + else (fix go ll := + match ll with + | nil => nil + | (f::r) => match findRecord l f with + | nil => go r + | x => x + end + end) r + | _ => nil + end. + +(* + * Rinclude is the same as Rmember except that it tests whether the location is a pointer to + * any cell within a node rather than just the first. It is used for 'inTreeLoc' defined in + * basicEval + * + * Parameters: + * l - location to test + * tree - a tree (which is the same form as parameter #4 to tree above + *) +Fixpoint basicEval (op : id) (args : list (@Value unit)) : @Value unit := + match (op,args) with + | (AbsNthId,((ListValue l)::(NatValue f)::nil)) => nth f l NoValue + | (AbsPlusId,((NatValue l)::(NatValue r)::nil)) => (NatValue (l+r)) + | (AbsMinusId,((NatValue l)::(NatValue r)::nil)) => (NatValue (l-r)) + | (AbsTimesId,((NatValue l)::(NatValue r)::nil)) => (NatValue (l*r)) + | (AbsEqualId,((NatValue l)::(NatValue r)::nil)) => if beq_nat l r then (NatValue 1) else (NatValue 0) + | (AbsLessId,((NatValue l)::(NatValue r)::nil)) => if ble_nat r l then (NatValue 0) else (NatValue 1) + | (AbsMemberId,((NatValue l)::tree::nil)) => if Rmember l tree then (NatValue 1) else (NatValue 0) + | (AbsIncludeId,((NatValue l)::tree::nil)) => if Rinclude l tree then (NatValue 1) else (NatValue 0) + | (AbsImplyId,((NatValue l)::r::nil)) => if beq_nat l 0 then NatValue 1 else r + | (AbsNotId,((NatValue l)::nil)) => if beq_nat l 0 then NatValue 1 else NatValue 0 + | (AbsAndId,((NatValue l)::r::nil)) => if beq_nat l 0 then NatValue 0 else r + | (AbsOrId,((NatValue l)::r::nil)) => if beq_nat l 0 then r else (NatValue l) + | (AbsIteId,((NatValue c)::t::e::nil)) => if beq_nat c 0 then e else t + | (AbsFindId,(v::(NatValue x)::nil)) => ListValue (@findRecord unit x v) + | (AbsListId,l) => @ListValue unit l + | (AbsRangeSetId,(f::nil)) => rangeSet f + | (AbsRangeNumericId,((NatValue s)::(NatValue e)::nil)) => numericRange s e + | (AbsReplaceNthId,((ListValue l)::(NatValue n)::e::nil)) => (ListValue (replacenth l n e)) + | _ => NoValue + end. + (* ************************************************************************************ * Definition of expression evaluation--note how the "f" parameter of absExp is used to * define the semantics of absFun. @@ -232,14 +369,57 @@ Inductive strip_option {x} : list (option x) -> list x -> Prop := * bindings - a list of bindings for quantified variables * exp - the expression to evaluate *) -Fixpoint absEval {ev} {eq} {f} (env : id -> nat) (bindings : list (@Value ev)) (exp : @absExp ev eq f) : (@Value ev) := +Fixpoint absEval (*{ev} {eq} {f}*) (env : id -> nat) (bindings : list (@Value unit)) (exp : @absExp) : (@Value unit) := match exp with | AbsConstVal v => v | AbsVar v => NatValue (env v) - | AbsFun id pl => f id (map (absEval env bindings) pl) - | AbsQVar n => nth n (rev bindings) NoValue + | AbsFun id pl => basicEval id (map (absEval env bindings) pl) + | AbsQVar n => nth n bindings NoValue + end. + +(************************************************************************************ + * + * absRefExp + * + * An expression that references the heap + * + ************************************************************************************) + +Inductive absRefExp (*{ev} + {eq : ev -> ev -> bool} + { f : id -> list (@Value ev) -> (@Value ev) }*) := + | AbsRefConstVal : (@Value unit) -> absRefExp + | AbsRefVar : id -> absRefExp + | AbsRefQVar : absVar -> absRefExp + | AbsRefRef : absRefExp -> absRefExp + | AbsRefFun : id -> list absRefExp -> absRefExp. + +(* ************************************************************************************ + * Definition of expression evaluation--note how the "f" parameter of absExp is used to + * define the semantics of absFun. + * + * Parameters: + * ev, eq, f - parameterization of absExp. + * env - the bindings for environment variables + * bindings - a list of bindings for quantified variables + * exp - the expression to evaluate + *) +Fixpoint absRefEval (*{ev} {eq} {f}*) (env : id -> nat) (bindings : list (@Value unit)) (h : heap) (exp : @absRefExp): (@Value unit) := + match exp with + | AbsRefConstVal v => v + | AbsRefVar v => NatValue (env v) + | AbsRefFun id pl => basicEval id (map (absRefEval env bindings h) pl) + | AbsRefRef e => match (absRefEval env bindings h e) with + | NatValue v => match (h v) with + | Some x => NatValue x + | None => NoValue + end + | _ => NoValue + end + | AbsRefQVar n => nth n (rev bindings) NoValue end. + (************************************************************************************ * * absState @@ -253,23 +433,75 @@ Fixpoint absEval {ev} {eq} {f} (env : id -> nat) (bindings : list (@Value ev)) ( * ************************************************************************************) -Inductive absState {ev} +Inductive absState (*{ev} {eq : ev -> ev -> bool} { f : id -> list (@Value ev) -> (@Value ev) } { t : id -> list (@Value ev) -> heap -> Prop } - { ac : id -> (id -> nat) -> (list (@Value ev)) -> (list (@Value ev)) -> (@absExp ev eq f) -> @Value ev -> Prop } := - | AbsExists : (@absExp ev eq f) -> @absState ev eq f t ac -> absState - | AbsExistsT : @absState ev eq f t ac -> absState - | AbsAll : (@absExp ev eq f) -> @absState ev eq f t ac -> absState - | AbsEach : (@absExp ev eq f) -> @absState ev eq f t ac -> absState - | AbsStar : @absState ev eq f t ac -> @absState ev eq f t ac -> absState - | AbsOrStar : @absState ev eq f t ac -> @absState ev eq f t ac -> absState + { ac : id -> (id -> nat) -> (list (@Value ev)) -> (list (@Value ev)) -> (@absExp ev eq f) -> @Value ev -> Prop }*) := + | AbsExists : (absExp) -> absState -> absState + | AbsExistsT : absState -> absState + | AbsAll : (absExp) -> absState -> absState + | AbsEach : (absExp) -> absState -> absState + | AbsStar : absState -> absState -> absState + | AbsOrStar : absState -> absState -> absState | AbsEmpty : absState - | AbsLeaf : id -> (list (@absExp ev eq f)) -> absState - | AbsAccumulate : id -> @absExp ev eq f -> @absExp ev eq f -> @absExp ev eq f -> absState - | AbsMagicWand : @absState ev eq f t ac -> @absState ev eq f t ac -> absState - | AbsUpdateVar : @absState ev eq f t ac -> id -> (@absExp ev eq f) -> absState - | AbsUpdState : @absState ev eq f t ac -> @absState ev eq f t ac -> @absState ev eq f t ac -> absState. + | AbsAny : absState + | AbsNone : absState + | AbsLeaf : id -> (list absExp) -> absState + | AbsAccumulate : id -> absExp -> absExp -> absExp -> absState + | AbsMagicWand : absState -> absState -> absState + | AbsUpdateVar : absState -> id -> absExp -> absState + | AbsUpdateLoc : absState-> (absExp) -> (absExp) -> absState + | AbsUpdateWithLoc : absState-> id -> (absExp) -> absState + | AbsUpdState : absState-> absState -> absState -> absState + | AbsClosure : absState -> (list absExp) -> absState. + +Fixpoint beq_absExpList (*{ev} {eq} {f}*) (l1 : list absExp) (l2 : list absExp) := + match l1,l2 with + | f1::r1,f2::r2 => if beq_absExp f1 f2 then beq_absExpList r1 r2 else false + | nil,nil => true + | _,_ => false + end. + +Fixpoint beq_absState (*{ev} {eq} {f} {t} {ac}*) (l : absState) (r : absState) := + match l,r with + | AbsExists e1 s1,AbsExists e2 s2 => if beq_absExp e1 e2 then beq_absState s1 s2 else false + | AbsExistsT s1, AbsExistsT s2 => beq_absState s1 s2 + | AbsAll e1 s1,AbsAll e2 s2 => if beq_absExp e1 e2 then beq_absState s1 s2 else false + | AbsEach e1 s1,AbsEach e2 s2 => if beq_absExp e1 e2 then beq_absState s1 s2 else false + | AbsStar l1 r1,AbsStar l2 r2 => if beq_absState l1 l2 then beq_absState r1 r2 else false + | AbsOrStar l1 r1,AbsOrStar l2 r2 => if beq_absState l1 l2 then beq_absState r1 r2 else false + | AbsMagicWand l1 r1,AbsMagicWand l2 r2 => if beq_absState l1 l2 then beq_absState r1 r2 else false + | AbsEmpty, AbsEmpty => true + | AbsNone, AbsNone => true + | AbsAny, AbsAny => true + | AbsAccumulate i1 ea1 ea2 ea3,AbsAccumulate i2 eb1 eb2 eb3 => + if beq_id i1 i2 then + (if beq_absExp ea1 eb1 then + (if beq_absExp ea2 eb2 then + beq_absExp ea3 eb3 else false) else false) else false + | AbsUpdateVar s1 i1 e1,AbsUpdateVar s2 i2 e2 => + if beq_id i1 i2 then + (if beq_absState s1 s2 then beq_absExp e1 e2 else false) + else false + | AbsUpdateLoc s1 i1 e1,AbsUpdateLoc s2 i2 e2 => + if beq_absExp i1 i2 then + (if beq_absState s1 s2 then beq_absExp e1 e2 else false) + else false + | AbsUpdateWithLoc s1 i1 e1,AbsUpdateWithLoc s2 i2 e2 => + if beq_id i1 i2 then + (if beq_absState s1 s2 then beq_absExp e1 e2 else false) + else false + | AbsUpdState s1 i1 e1,AbsUpdState s2 i2 e2 => + if beq_absState i1 i2 then + (if beq_absState s1 s2 then beq_absState e1 e2 else false) + else false + | AbsLeaf i1 el1, AbsLeaf i2 el2 => + if beq_id i1 i2 then beq_absExpList el1 el2 else false + (*| AbsClosure s1 el1,AbsClosure s2 el2 => + beq_absExpList el1 el2 else false*) + | _,_ => false + end. Notation "x '**' y" := (AbsStar x y) (at level 100, right associativity). @@ -280,18 +512,18 @@ Notation "x '*\/*' y" := (AbsOrStar x y) (* Auxiliary functions--either used in realizedState below or in theorems involving realizeState (in other files) *) -Fixpoint instantiateExp {ev:Type} {eq} {t} (e : @absExp ev eq t) (val:@Value ev) : absExp := +Fixpoint instantiateExp (*{ev:Type} {eq} {t}*) (e : absExp) (val:@Value unit) : absExp := match e with | AbsConstVal v => AbsConstVal v | AbsVar v => AbsVar v | AbsQVar v => match v with - | 0 => @AbsConstVal ev eq t val + | 0 => AbsConstVal val | S x => AbsQVar x end | AbsFun id pl => AbsFun id (map (fun x => instantiateExp x val) pl) end. -Fixpoint instantiateState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (val:@Value ev) : absState := +Fixpoint instantiateState (*{ev} {eq} {f} {t} {ac}*) (s : absState) (val:@Value unit) : absState := match s with | AbsStar s1 s2 => (AbsStar (instantiateState s1 val) (instantiateState s2 val)) | AbsOrStar s1 s2 => (AbsOrStar (instantiateState s1 val) (instantiateState s2 val)) @@ -301,10 +533,15 @@ Fixpoint instantiateState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (v | AbsEach e s => AbsEach (instantiateExp e val) (instantiateState s val) | AbsLeaf i el => AbsLeaf i (map (fun x => instantiateExp x val) el) | AbsAccumulate i e1 e2 e3 => AbsAccumulate i (instantiateExp e1 val) (instantiateExp e2 val) (instantiateExp e3 val) - | AbsEmpty => @AbsEmpty ev eq f t ac + | AbsEmpty => AbsEmpty + | AbsAny => AbsAny + | AbsNone => AbsNone | AbsMagicWand s1 s2 => AbsMagicWand (instantiateState s1 val) (instantiateState s2 val) | AbsUpdateVar s v vall => AbsUpdateVar (instantiateState s val) v (instantiateExp vall val) + | AbsUpdateWithLoc s v vall => AbsUpdateWithLoc (instantiateState s val) v (instantiateExp vall val) + | AbsUpdateLoc s l vall => AbsUpdateLoc (instantiateState s val) (instantiateExp l val) (instantiateExp vall val) | AbsUpdState s11 s22 s33 => AbsUpdState (instantiateState s11 val) (instantiateState s22 val) (instantiateState s33 val) + | AbsClosure s l => AbsClosure s (map (fun x => instantiateExp x val) l) end. (* Some auxiliary definitions useful for realizeState *) @@ -323,6 +560,223 @@ Inductive allSeconds {t1} {t2} : list t1 -> list (t2 * t1) -> Prop := | ASNil : allSeconds nil nil | ASCons : forall fx fy r r', allSeconds r r' -> allSeconds (fy::r) ((fx,fy)::r'). +Inductive anyHeap : nat -> nat -> heap -> Prop := + | AnyHeapBase : forall start, + anyHeap start 0 (fun x => None) + | AnyHeapNext : forall start next heap y, + anyHeap (S start) next heap -> + anyHeap start (S next) (fun x => if beq_nat x start then Some y else heap x). + +Inductive Rcell : nat -> (list nat) -> heap -> nat -> Prop := + | RCellBase : forall l ll h, + Rcell l ll h l + | RCellNext : forall l ll index h n nn, + mem_nat index ll=true -> + h (n+index)=Some nn -> + Rcell l ll h n -> + Rcell l ll h nn. + +Inductive mergeHeaps : (list heap) -> heap -> Prop := + | MHBase : mergeHeaps nil (fun x => None) + | MHNext : forall f r h1 h2 h, + mergeHeaps r h2 -> + (forall x, h1 x=None \/ h2 x=None) -> + h = (fun x => match h1 x with None => h2 x | Some x => Some x end) -> + mergeHeaps (f::r) h. + +Inductive heapWithIndexList {t} : (list nat) -> (list heap) -> (list (@Value t)) -> (list (nat * heap * (@Value t))) -> Prop := + | HWIBase : heapWithIndexList nil nil nil nil + | HWINext : forall ir hr ihr br i h b, + heapWithIndexList ir hr br ihr -> + heapWithIndexList (i::ir) (h::hr) (b::br) ((i,h,b)::ihr). + +Fixpoint findIndex {t} (n : nat) (h : heap) (l : list (nat * heap * (@Value t))) : @Value t := + match l with + | nil => match h n with + | Some x => NatValue x + | None => NatValue 0 + end + | ((nn,hh,v)::r) => if beq_nat n nn then v else findIndex n h r + end. + +Fixpoint buildList {t} (i : nat) (size : nat) (h : heap) (l : list (nat * heap * (@Value t))) : list (@Value t) := + match size with + | 0 => nil + | (S s) => (findIndex i h l)::(buildList (S i) s h l) + end. + +Inductive ihmem {t} : nat -> heap -> @Value t -> (list (nat * heap * (@Value t))) -> Prop := + | IHBase : forall n h v hl, + ihmem n h v ((n,h,v)::hl) + | IHNext : forall n h v f hl, + ihmem n h v hl -> + ihmem n h v (f::hl). + +(* + * Recursive definition for the TREE construct--used in the definition of basicState + * + * Parameters: + * #1 - root of tree + * #2 - size of each node in the tree + * #3 - list of offsets to fields for each node + * #4 - functional representation of the tree + * #5 - concrete heap (Must be exact heap for the tree) + *) +Inductive Tree {t} : nat -> nat -> (list nat) -> (@Value t) -> heap -> Prop := + | TreeNext : forall root size indices heaps ihlist h0 h1 heap values vals, + size > 0 -> + anyHeap root size h0 -> + heapWithIndexList indices heaps values ihlist -> + not(root=0) -> + (forall i h v x, ihmem i h v ihlist -> Some x=h0 (root+x) -> Tree x size indices v h) -> + mergeHeaps heaps h1 -> + (forall l, (h1 l=None \/ h0 l=None)) -> + heap = (fun x => match h1 x with None => h0 x | Some x => Some x end) -> + vals = buildList root size heap ihlist -> + Tree root size indices (ListValue ((NatValue root)::vals)) heap + | TreeBase : forall size index h, + size > 0 -> + (forall v, h v=None) -> + Tree 0 size index (ListValue ((NatValue 0)::nil)) h. + + + +(* + * Rmember is a predicate used in AbsPredicate constructs to determine whether a nat + * is in fact a pointer to the head of any of the nodes in the list or tree represented + * by an RFun construct. + * + * Parameters: + * l - location to test + * tree - a tree (which is the same form as parameter #4 to tree above + * + * This definition is used in basicEval for the 'inTree' function + *) + +Theorem rootIsMember : forall t root size fields heap (v : @Value t), + root <> 0 -> + Tree root size fields v heap -> + Rmember root v=true. +Proof. admit. Admitted. + +Inductive strip_nat_values {t} : (list (@Value t)) -> (list nat) -> Prop := + | SNVNil : strip_nat_values nil nil + | SNVCons : forall v a b, + strip_nat_values a b -> + strip_nat_values ((NatValue v)::a) (v::b). +(*************************************************************************** + * + * basicState + * + * This is used to fill in the 't' parameter in absState. + * + ***************************************************************************) + +Notation "'AbsPredicateId'" := (Id 101) (at level 1). +Notation "'AbsTreeId'" := (Id 102) (at level 1). +Notation "'AbsCellId'" := (Id 103) (at level 1). +Notation "'AbsArrayId'" := (Id 104) (at level 1). +Notation "'AbsPathId'" := (Id 105) (at level 1). + +Inductive anyHeapv {t} : nat -> nat -> heap -> (list (@Value t)) -> Prop := + | AnyHeapvBase : forall start, + anyHeapv start 0 (fun x => None) nil + | AnyHeapvNext : forall start next heap y r, + anyHeapv (S start) next heap r -> + anyHeapv start (S next) (fun x => if beq_nat x start then Some y else heap x) + ((NatValue y)::r). + +Inductive valueIndexList {t} : (list nat) -> (list (@Value t)) -> (list (nat * (@Value t))) -> Prop := + | VIBase : valueIndexList nil nil nil + | VINext : forall ir br i b ibr, + valueIndexList ir br ibr -> + valueIndexList (i::ir) (b::br) ((i,b)::ibr). + +Inductive imem {t} : nat -> @Value t -> (list (nat * (@Value t))) -> Prop := + | IBase : forall n v hl, + imem n v ((n,v)::hl) + | INext : forall n v f hl, + imem n v hl -> + imem n v (f::hl). + +Inductive updateRec {t} : (list (nat * (@Value t))) -> nat -> list (@Value t) -> list (@Value t) -> Prop := + | UBase : forall n vl, + updateRec vl n nil nil + | UMem : forall n v vl or nr x, + imem n v vl -> + updateRec vl (n+1) or nr -> + updateRec vl n (x::or) (v::nr) + | UDef1 : forall n v vl or nr x, + not(imem n v vl) -> + updateRec vl (n+1) or nr -> + updateRec vl n ((NatValue x)::or) ((NatValue x)::or) + | UDef2 : forall n v vl or nr x rr, + not(imem n v vl) -> + updateRec vl (n+1) or nr -> + updateRec vl n ((ListValue ((NatValue x)::rr))::or) ((NatValue x)::or). + +Inductive Path {t} : nat -> nat -> (list nat) -> (@Value t) -> (@Value t) -> Prop := + | PathNext : forall root size indices baseData rec vals ivals rec2, + size > 0 -> + not(root=0) -> + ((NatValue root)::rec) = findRecord root baseData -> + valueIndexList indices vals ivals -> + (forall i x v r, imem i v ivals -> ((ListValue ((NatValue x)::r))=nth i rec NoValue /\ Path x size indices baseData v)) -> + updateRec ivals 0 rec rec2 -> + Path root size indices baseData (ListValue (NatValue root::rec2)) + | PathBase : forall size l h, + size > 0 -> + Path 0 size l h (ListValue ((NatValue 0)::nil)). +Inductive basicState: id -> list (@Value unit) -> heap -> Prop := + | BTStatePredicate : forall e h, + e<>0 -> + (forall x, h x = None) -> + basicState AbsPredicateId ((NatValue e)::nil) h + | BStateTree : forall r s f h ff tt, + Tree r s f tt h -> + strip_nat_values ff f -> + basicState AbsTreeId ((NatValue r)::tt::(NatValue s)::ff) h + | BStatePath : forall r s f base path h ff, + Path r s f base path -> + strip_nat_values ff f -> + (forall x, h x = None) -> + basicState AbsPathId ((NatValue r)::base::path::(NatValue s)::ff) h + | BStateArray : forall r s h vl, + anyHeapv r s h vl-> + basicState AbsArrayId ((NatValue r)::(NatValue s)::(ListValue vl)::nil) h + | BTStateCell : forall v l h, + h l = Some v -> + l<>0 -> + (forall x, x<>l -> h x=None) -> + basicState AbsCellId ((NatValue l)::(NatValue v)::nil) h. + +(*************************************************************************** + * + * basicAccumulate + * + * This is used to fill in the 'ac' parameter in absState. For now, this is + * a place holder. There are no actual definitions. + * + ***************************************************************************) + +Notation "'AbsSumId'" := (Id 201) (at level 1). + +Inductive sumValues (*{t} {teq} {f}*) : (id -> nat) -> (list (@Value unit)) -> (list (@Value unit)) -> (absExp) -> (@Value unit) -> Prop := + | SumNil : forall b e env, + sumValues env b nil e (NatValue 0) + | SumCons : forall b e x ff r env y v, + sumValues env b r e (NatValue x) -> + absEval env (ff::b) e = NatValue v -> + y = x+v -> + sumValues env b (ff::r) e (NatValue y). + +Inductive basicAccumulate (*{t} {teq} {f}*) : id -> (id -> nat) -> (list (@Value unit)) -> (list (@Value unit)) -> + absExp -> + (@Value unit) -> Prop := + | BASum : forall env b e l tt, + sumValues env b l e tt -> + basicAccumulate AbsSumId env b l e tt. + (****************************************************************************** * realizeState - This function defines the semantics of abstract states with * respect to concrete states. @@ -336,7 +790,7 @@ Inductive allSeconds {t1} {t2} : list t1 -> list (t2 * t1) -> Prop := * ******************************************************************************) -Inductive realizeState {ev} {eq} {f} {t} {ac} : (@absState ev eq f t ac) -> list (@Value ev) -> state -> Prop := +Inductive realizeState (*{ev} {eq} {f} {t} {ac}*) : absState -> list (@Value unit) -> state -> Prop := | RSCompose : forall s1 s2 as1 as2 s3 bindings, realizeState as1 bindings s1 -> realizeState as2 bindings s2 -> @@ -348,39 +802,40 @@ Inductive realizeState {ev} {eq} {f} {t} {ac} : (@absState ev eq f t ac) -> list | RSOrComposeR : forall s2 as1 as2 bindings, realizeState as2 bindings s2 -> realizeState (AbsOrStar as1 as2) bindings s2 - | RSExists : forall (s:state) (a:absState) e (v : @Value ev) rl bindings, - absEval (env_p _ _ s) bindings e = v -> + | RSExists : forall (s:state) (a:absState) e (v : @Value unit) rl bindings, + absEval (env_p s) bindings e = v -> v = (ListValue rl) -> (exists x, In x rl /\ - realizeState a (bindings++(x::nil)) s) -> + realizeState a (x::bindings) s) -> realizeState (AbsExists e a) bindings s | RSExistsU : forall s a bindings, - (exists x, realizeState a (bindings++(x::nil)) s) -> + (exists x, realizeState a (x::bindings) s) -> realizeState (AbsExistsT a) bindings s | RSAccumulate : forall s e1 e2 e3 vl v3 i bindings, - absEval (env_p _ _ s) bindings e1 = (ListValue vl) -> - absEval (env_p _ _ s) bindings e3 = v3 -> - ac i (env_p _ _ s) bindings vl e2 v3 -> + absEval (env_p s) bindings e1 = (ListValue vl) -> + absEval (env_p s) bindings e3 = v3 -> + basicAccumulate i (env_p s) bindings vl e2 v3 -> realizeState (AbsAccumulate i e1 e2 e3) bindings s | RSAll : forall (s:state) (a:absState) e v rl bindings, - absEval (env_p _ _ s) bindings e = v -> + absEval (env_p s) bindings e = v -> v = ListValue rl -> (forall x, In x rl -> - realizeState a (bindings++(x::nil)) s) -> + realizeState a (x::bindings) s) -> realizeState (AbsAll e a) bindings s | RSEach : forall (s:state) (a:absState) e v rl states bindings l, - absEval (env_p _ _ s) bindings e = v -> + absEval (env_p s) bindings e = v -> v = ListValue rl -> allFirsts rl l -> allSeconds states l -> - (forall x y, In (x,y) l -> realizeState a (bindings++(x::nil)) y) -> + (forall x y, In (x,y) l -> realizeState a (x::bindings) y) -> fold_compose states s -> realizeState (AbsEach e a) bindings s | RSEmpty : forall s bindings, (forall x, snd s x=None) -> realizeState AbsEmpty bindings s + | RSAny : forall s bindings, realizeState AbsAny bindings s | RSR : forall s el vl i bindings, - map (absEval (env_p _ _ s) bindings) el = vl -> - t i vl (snd s) -> + map (absEval (env_p s) bindings) el = vl -> + basicState i vl (snd s) -> realizeState (AbsLeaf i el) bindings s | RSMagicWand : forall s1 s2 as1 as2 s3 bindings, realizeState as1 bindings s1 -> @@ -389,23 +844,42 @@ Inductive realizeState {ev} {eq} {f} {t} {ac} : (@absState ev eq f t ac) -> list realizeState (AbsMagicWand as1 as2) bindings s3 | RSUpdateVar : forall s s1 as1 vv valaa valc bindings, realizeState as1 bindings s1 -> - (NatValue valc) = absEval (env_p _ _ s) bindings valaa -> - (heap_p _ _ s) = (heap_p _ _ s1) -> - (override (env_p _ _ s) vv valc)= (env_p _ _ s1) -> - realizeState (AbsUpdateVar as1 vv valaa) bindings s1 + (NatValue valc) = absEval (env_p s) bindings valaa -> + (heap_p s) = (heap_p s1) -> + (override (env_p s) vv valc)= (env_p s1) -> + realizeState (AbsUpdateVar as1 vv valaa) bindings s + | RSUpdateWithLoc : forall s s1 as1 vv valaa valc bindings vald, + realizeState as1 bindings s1 -> + (NatValue valc) = absEval (env_p s) bindings valaa -> + (heap_p s) = (heap_p s1) -> + (heap_p s) valc = Some vald -> + (override (env_p s) vv vald)= (env_p s1) -> + realizeState (AbsUpdateWithLoc as1 vv valaa) bindings s + | RSUpdateLoc : forall s s1 as1 l ll valaa valc bindings qq, + realizeState as1 bindings s1 -> + heap_p s1 = qq -> + (NatValue ll) = absEval (env_p s) bindings l -> + (NatValue valc) = absEval (env_p s) bindings valaa -> + (heap_p s) = (fun fff => if beq_nat fff ll then Some valc else (heap_p s1) fff) -> + (env_p s) = (env_p s1) -> + realizeState (AbsUpdateLoc as1 l valaa) bindings s | RSUpdState : forall s1 s2 s3 as1 as2 as3 s4 s5 bindings, realizeState as1 bindings s1 -> realizeState as2 bindings s2 -> realizeState as3 bindings s3 -> concreteCompose s4 s2 s1 -> concreteCompose s4 s3 s5 -> - realizeState (AbsUpdState as1 as2 as3) bindings s5. + realizeState (AbsUpdState as1 as2 as3) bindings s5 + | RSClosure : forall e h as1 bindings el b, + map (absEval e bindings) el = b -> + realizeState as1 b (empty_env,h) -> + realizeState (AbsClosure as1 el) bindings (e,h). Theorem emptyConcreteCompose : forall e, concreteCompose (e,empty_heap) (e,empty_heap) (e,empty_heap). Proof. intros. unfold concreteCompose. crunch. left. unfold empty_heap. reflexivity. -Qed. +Qed. (****************************************************************************** * This section contains a whole bunch of auxiliary definitions which are useful @@ -413,15 +887,15 @@ Qed. * other files. ******************************************************************************) -Fixpoint pushAbsVar {T} {eq} {f} (e : @absExp T eq f) : @absExp T eq f := +(*Fixpoint pushAbsVar (e : absExp) : absExp := match e with | AbsConstVal v => AbsConstVal v | AbsVar vv => AbsVar vv | AbsQVar v => AbsQVar (S v) | AbsFun i el => AbsFun i (map pushAbsVar el) - end. + end. -Fixpoint pushAbsVarState {EV} {EQ} {F} {T} {AC} (s : @absState EV EQ F T AC) : @absState EV EQ F T AC := +Fixpoint pushAbsVarState (s : absState) : absState := match s with | AbsStar s1 s2 => (AbsStar (pushAbsVarState s1) (pushAbsVarState s2)) | AbsOrStar s1 s2 => (AbsOrStar (pushAbsVarState s1) (pushAbsVarState s2)) @@ -431,34 +905,44 @@ Fixpoint pushAbsVarState {EV} {EQ} {F} {T} {AC} (s : @absState EV EQ F T AC) : @ | AbsEach e s => AbsEach (pushAbsVar e) (pushAbsVarState s) | AbsAccumulate i e1 e2 e3 => AbsAccumulate i (pushAbsVar e1) (pushAbsVar e2) (pushAbsVar e3) | AbsEmpty => AbsEmpty + | AbsAny => AbsAny + | AbsNone => AbsNone | AbsLeaf i el => AbsLeaf i (map pushAbsVar el) | AbsMagicWand s1 s2 => (AbsMagicWand (pushAbsVarState s1) (pushAbsVarState s2)) + | AbsUpdateWithLoc s v vall => (AbsUpdateWithLoc (pushAbsVarState s) v (pushAbsVar vall)) | AbsUpdateVar s v vall => (AbsUpdateVar (pushAbsVarState s) v (pushAbsVar vall)) + | AbsUpdateLoc s v vall => (AbsUpdateLoc (pushAbsVarState s) (pushAbsVar v) (pushAbsVar vall)) | AbsUpdState s1 s2 s3 => (AbsUpdState (pushAbsVarState s1) (pushAbsVarState s2) (pushAbsVarState s3)) - end. + | AbsClosure s el => (AbsClosure s (map pushAbsVar el)) + end.*) -Fixpoint quantifyAbsVar {EV} {EQ} {T} (e : @absExp EV EQ T) (v:id) : @absExp EV EQ T := +Fixpoint quantifyAbsVar (e : absExp) (vn : nat) (n : nat) (v:id) : absExp := match e with | AbsConstVal v => AbsConstVal v - | AbsVar vv => if beq_id vv v then AbsQVar 0 else AbsVar vv - | AbsQVar v => AbsQVar (S v) - | AbsFun i el => AbsFun i (map (fun x => quantifyAbsVar x v) el) + | AbsVar vv => if beq_id vv v then AbsQVar vn else AbsVar vv + | AbsQVar vv => if ble_nat n vv then AbsQVar (vv+1) else AbsQVar vv + | AbsFun i el => AbsFun i (map (fun x => quantifyAbsVar x vn n v) el) end. -Fixpoint quantifyAbsVarState {EV} {EQ} {F} {T} {AC} (s : @absState EV EQ F T AC) (v:id) : @absState EV EQ F T AC := +Fixpoint quantifyAbsVarState (s : absState) (vn : nat) (n:nat) (v:id) : absState := match s with - | AbsStar s1 s2 => (AbsStar (quantifyAbsVarState s1 v) (quantifyAbsVarState s2 v)) - | AbsOrStar s1 s2 => (AbsOrStar (quantifyAbsVarState s1 v) (quantifyAbsVarState s2 v)) - | AbsExists e s => AbsExists (quantifyAbsVar e v) (quantifyAbsVarState s v) - | AbsExistsT s => AbsExistsT (quantifyAbsVarState s v) - | AbsAll e s => AbsAll (quantifyAbsVar e v) (quantifyAbsVarState s v) - | AbsEach e s => AbsEach (quantifyAbsVar e v) (quantifyAbsVarState s v) + | AbsStar s1 s2 => (AbsStar (quantifyAbsVarState s1 vn n v) (quantifyAbsVarState s2 vn n v)) + | AbsOrStar s1 s2 => (AbsOrStar (quantifyAbsVarState s1 vn n v) (quantifyAbsVarState s2 vn n v)) + | AbsExists e s => AbsExists (quantifyAbsVar e vn n v) (quantifyAbsVarState s (S vn) (S n) v) + | AbsExistsT s => AbsExistsT (quantifyAbsVarState s (S vn) (S n) v) + | AbsAll e s => AbsAll (quantifyAbsVar e vn n v) (quantifyAbsVarState s (S vn) (S n) v) + | AbsEach e s => AbsEach (quantifyAbsVar e vn n v) (quantifyAbsVarState s (S vn) (S n) v) | AbsEmpty => AbsEmpty - | AbsAccumulate i e1 e2 e3 => AbsAccumulate i (quantifyAbsVar e1 v) (quantifyAbsVar e2 v) (quantifyAbsVar e3 v) - | AbsLeaf i el => AbsLeaf i (map (fun x => quantifyAbsVar x v) el) - | AbsMagicWand s1 s2 => (AbsMagicWand (quantifyAbsVarState s1 v) (quantifyAbsVarState s2 v)) - | AbsUpdateVar s v vall => (AbsUpdateVar (quantifyAbsVarState s v) v (quantifyAbsVar vall v)) - | AbsUpdState s1 s2 s3 => (AbsUpdState (quantifyAbsVarState s1 v) (quantifyAbsVarState s2 v) (quantifyAbsVarState s3 v)) + | AbsAny => AbsAny + | AbsNone => AbsNone + | AbsAccumulate i e1 e2 e3 => AbsAccumulate i (quantifyAbsVar e1 vn n v) (quantifyAbsVar e2 vn n v) (quantifyAbsVar e3 vn n v) + | AbsLeaf i el => AbsLeaf i (map (fun x => quantifyAbsVar x vn n v) el) + | AbsMagicWand s1 s2 => (AbsMagicWand (quantifyAbsVarState s1 vn n v) (quantifyAbsVarState s2 vn n v)) + | AbsUpdateVar s vv vall => (AbsUpdateVar (quantifyAbsVarState s vn n v) vv (quantifyAbsVar vall vn n v)) + | AbsUpdateWithLoc s vv vall => (AbsUpdateWithLoc (quantifyAbsVarState s vn n v) vv (quantifyAbsVar vall vn n v)) + | AbsUpdateLoc s l vall => (AbsUpdateLoc (quantifyAbsVarState s vn n v) (quantifyAbsVar l vn n v) (quantifyAbsVar vall vn n v)) + | AbsUpdState s1 s2 s3 => (AbsUpdState (quantifyAbsVarState s1 vn n v) (quantifyAbsVarState s2 vn n v) (quantifyAbsVarState s3 vn n v)) + | AbsClosure s el => (AbsClosure s (map (fun x => quantifyAbsVar x vn n v) el)) end. Fixpoint convertAbsValue {ev} {ev'} (m : ev -> ev') (v : @Value ev) : @Value ev' := @@ -469,16 +953,16 @@ Fixpoint convertAbsValue {ev} {ev'} (m : ev -> ev') (v : @Value ev) : @Value ev' | OtherValue v => OtherValue (m v) end. -Fixpoint convertAbsExp {ev} {eq} {f} {ev'} {eq'} {f'} (m : ev -> ev') (e : @absExp ev eq f) : @absExp ev' eq' f' := +Fixpoint convertAbsExp (e : absExp) : absExp := match e with - | AbsConstVal v => @AbsConstVal ev' eq' f' (convertAbsValue m v) + | AbsConstVal v => AbsConstVal v | AbsVar v => AbsVar v | AbsQVar v => AbsQVar v - | AbsFun id pl => AbsFun id (map (convertAbsExp m) pl) + | AbsFun id pl => AbsFun id pl end. -Fixpoint subst {ev} {eq} {f} (e : @absExp ev eq f ) (n: nat) (val:@absExp ev eq f) : @absExp ev eq f := +Fixpoint subst (e : absExp) (n: nat) (val:absExp) : absExp := match e with | AbsConstVal x => AbsConstVal x | AbsVar v => AbsVar v @@ -486,23 +970,57 @@ Fixpoint subst {ev} {eq} {f} (e : @absExp ev eq f ) (n: nat) (val:@absExp ev eq | AbsFun i l => AbsFun i (map (fun x => subst x n val) l) end. -Fixpoint substState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (n : nat) (val:@absExp ev eq f) : @absState ev eq f t ac := +Fixpoint substState (s : absState) (n : nat) (val:absExp) : absState := match s with | AbsStar s1 s2 => (AbsStar (substState s1 n val) (substState s2 n val)) | AbsOrStar s1 s2 => (AbsOrStar (substState s1 n val) (substState s2 n val)) - | AbsExistsT s => AbsExistsT (substState s n val) - | AbsExists e s => AbsExists (subst e n val) (substState s n val) - | AbsAll e s => AbsAll (subst e n val) (substState s n val) - | AbsEach e s => AbsEach (subst e n val) (substState s n val) + | AbsExistsT s => AbsExistsT (substState s (S n) val) + | AbsExists e s => AbsExists (subst e n val) (substState s (S n) val) + | AbsAll e s => AbsAll (subst e n val) (substState s (S n) val) + | AbsEach e s => AbsEach (subst e n val) (substState s (S n) val) | AbsEmpty => AbsEmpty + | AbsAny => AbsAny + | AbsNone => AbsNone | AbsLeaf i l => AbsLeaf i (map (fun x => subst x n val) l) | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (subst e1 n val) (subst e2 n val) (subst e3 n val) | AbsMagicWand s1 s2 => AbsMagicWand (substState s1 n val) (substState s2 n val) - | AbsUpdateVar s v vall => AbsUpdateVar (substState s n val) v (subst vall n val) + | AbsUpdateVar s v vall => AbsUpdateVar (substState s n val) v (subst vall n val) + | AbsUpdateWithLoc s v vall => AbsUpdateWithLoc (substState s n val) v (subst vall n val) + | AbsUpdateLoc s l vall => AbsUpdateLoc (substState s n val) (subst l n val) (subst vall n val) | AbsUpdState s1 s2 s3 => (AbsUpdState (substState s1 n val) (substState s2 n val) (substState s3 n val)) + | AbsClosure s l => AbsClosure s (map (fun x => subst x n val) l) + end. + +Fixpoint addExpVar (v : nat) (e : absExp) : absExp := + match e with + | AbsConstVal v => AbsConstVal v + | AbsVar v => AbsVar v + | AbsQVar vv => if ble_nat v vv then AbsQVar (vv+1) else AbsQVar vv + | AbsFun i l => AbsFun i (map (addExpVar v) l) + end. + +Fixpoint addStateVar (n : nat) (s : absState) : absState := + match s with + | AbsStar s1 s2 => (AbsStar (addStateVar n s1) (addStateVar n s2)) + | AbsOrStar s1 s2 => (AbsOrStar (addStateVar n s1) (addStateVar n s2)) + | AbsExistsT s => AbsExistsT (addStateVar (S n) s) + | AbsExists e s => AbsExists (addExpVar n e) (addStateVar (S n) s) + | AbsAll e s => AbsAll (addExpVar n e) (addStateVar (S n) s) + | AbsEach e s => AbsEach (addExpVar n e) (addStateVar (S n) s) + | AbsEmpty => AbsEmpty + | AbsAny => AbsAny + | AbsNone => AbsNone + | AbsLeaf i l => AbsLeaf i (map (addExpVar n) l) + | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (addExpVar n e1) (addExpVar n e2) (addExpVar n e3) + | AbsMagicWand s1 s2 => AbsMagicWand (addStateVar n s1) (addStateVar n s2) + | AbsUpdateVar s v vall => AbsUpdateVar (addStateVar n s) v (addExpVar n vall) + | AbsUpdateWithLoc s v vall => AbsUpdateWithLoc (addStateVar n s) v (addExpVar n vall) + | AbsUpdateLoc s v vall => AbsUpdateLoc (addStateVar n s) (addExpVar n v) (addExpVar n vall) + | AbsUpdState s1 s2 s3 => (AbsUpdState (addStateVar n s1) (addStateVar n s2) (addStateVar n s3)) + | AbsClosure s l => AbsClosure s (map (addExpVar n) l) end. -Fixpoint substVar {ev} {eq} {f} (e : @absExp ev eq f) (n: id) (val:@absExp ev eq f) : absExp := +Fixpoint substVar (e : absExp) (n: id) (val:absExp) : absExp := match e with | AbsConstVal v => AbsConstVal v | AbsVar v => if beq_id v n then val else AbsVar v @@ -510,23 +1028,63 @@ Fixpoint substVar {ev} {eq} {f} (e : @absExp ev eq f) (n: id) (val:@absExp ev eq | AbsFun i l => AbsFun i (map (fun x => substVar x n val) l) end. -Fixpoint substVarState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (n : id) (val:@absExp ev eq f) : @absState ev eq f t ac := +Fixpoint substVarState (s : absState) (n : id) (val:absExp) : option absState := match s with - | AbsStar s1 s2 => (AbsStar (substVarState s1 n val) (substVarState s2 n val)) - | AbsOrStar s1 s2 => (AbsOrStar (substVarState s1 n val) (substVarState s2 n val)) - | AbsExistsT s => AbsExistsT (substVarState s n val) - | AbsExists e s => AbsExists (substVar e n val) (substVarState s n val) - | AbsAll e s => AbsAll (substVar e n val) (substVarState s n val) - | AbsEach e s => AbsEach (substVar e n val) (substVarState s n val) - | AbsEmpty => AbsEmpty - | AbsLeaf i l => AbsLeaf i (map (fun x => substVar x n val) l) - | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (substVar e1 n val) (substVar e2 n val) (substVar e3 n val) - | AbsMagicWand s1 s2 => AbsMagicWand (substVarState s1 n val) (substVarState s2 n val) - | AbsUpdateVar s v vall => AbsUpdateVar (substVarState s n val) v (substVar vall n val) - | AbsUpdState s1 s2 s3 => (AbsUpdState (substVarState s1 n val) (substVarState s2 n val) (substVarState s3 n val)) + | AbsStar s1 s2 => match substVarState s1 n val,substVarState s2 n val with + | Some a,Some b => Some (AbsStar a b) + | _,_ => None + end + | AbsOrStar s1 s2 => match substVarState s1 n val,substVarState s2 n val with + | Some a,Some b => Some (AbsOrStar a b) + | _,_ => None + end + | AbsExistsT s => match substVarState s n (addExpVar 0 val) with + | Some x => Some (AbsExistsT x) + | _ => None + end + | AbsExists e s => match substVarState s n (addExpVar 0 val) with + | Some x => Some (AbsExists (substVar e n val) x) + | None => None + end + | AbsAll e s => match substVarState s n (addExpVar 0 val) with + | Some x => Some (AbsAll (substVar e n val) x) + | None => None + end + | AbsEach e s => match substVarState s n (addExpVar 0 val) with + | Some x => Some (AbsEach (substVar e n val) x) + | None => None + end + | AbsEmpty => Some AbsEmpty + | AbsAny => Some AbsAny + | AbsNone => Some AbsNone + | AbsLeaf i l => Some (AbsLeaf i (map (fun x => substVar x n val) l)) + | AbsAccumulate id e1 e2 e3 => Some (AbsAccumulate id (substVar e1 n val) (substVar e2 n val) (substVar e3 n val)) + | AbsMagicWand s1 s2 => match substVarState s1 n val,substVarState s2 n val with + | Some a,Some b => Some (AbsMagicWand a b) + | _,_ => None + end + | AbsUpdateVar s v vall => if beq_id v n then None + else match substVarState s n val with + | Some x => Some (AbsUpdateVar x v (substVar vall n val)) + | _ => None + end + | AbsUpdateWithLoc s v vall => if beq_id v n then None + else match substVarState s n val with + | Some x => Some (AbsUpdateWithLoc x v (substVar vall n val)) + | _ => None + end + | AbsUpdateLoc s v vall => match (substVarState s n val),(substVar v n val),(substVar vall n val) with + | Some a,b,c => Some (AbsUpdateLoc a b c) + | _,_,_ => None + end + | AbsUpdState s1 s2 s3 => match (substVarState s1 n val),(substVarState s2 n val),(substVarState s3 n val) with + | Some a,Some b,Some c => Some (AbsUpdState a b c) + | _,_,_ => None + end + | AbsClosure s l => Some (AbsClosure s (map (fun x => substVar x n val) l)) end. -Fixpoint hasVnExp {ev} {eq} {f} (e : @absExp ev eq f) (v : absVar) : bool := +Fixpoint hasVnExp (e : absExp) (v : absVar) : bool := match e with | AbsConstVal v => false | AbsVar vv => false @@ -537,14 +1095,14 @@ Fixpoint hasVnExp {ev} {eq} {f} (e : @absExp ev eq f) (v : absVar) : bool := end) l end. -Fixpoint hasVnState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (v : absVar) := +Fixpoint hasVnState (s : absState) (v : absVar) : bool := match s with | AbsStar s1 s2 => if (hasVnState s1 v:bool) then true else hasVnState s2 v | AbsOrStar s1 s2 => if (hasVnState s1 v:bool) then true else hasVnState s2 v - | AbsExistsT s => hasVnState s v - | AbsExists e s => if hasVnExp e v then true else hasVnState s v - | AbsAll e s => if hasVnExp e v then true else hasVnState s v - | AbsEach e s => if hasVnExp e v then true else hasVnState s v + | AbsExistsT s => hasVnState s (S v) + | AbsExists e s => if hasVnExp e v then true else hasVnState s (S v) + | AbsAll e s => if hasVnExp e v then true else hasVnState s (S v) + | AbsEach e s => if hasVnExp e v then true else hasVnState s (S v) | AbsLeaf i l => (fix go l := match l with | (f::r) => if hasVnExp f v then true else go r | nil => false @@ -554,13 +1112,99 @@ Fixpoint hasVnState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (v : abs if hasVnExp e3 v then true else false | AbsMagicWand s1 s2 => if (hasVnState s1 v:bool) then true else hasVnState s2 v | AbsUpdateVar s vv vall => if (hasVnState s v:bool) then true else hasVnExp vall v + | AbsUpdateWithLoc s vv vall => if (hasVnState s v:bool) then true else hasVnExp vall v + | AbsUpdateLoc s l vall => if (hasVnState s v) then true + else (if hasVnExp vall v then true else hasVnExp l v) | AbsUpdState s1 s2 s3 => if (hasVnState s1 v:bool) then true else if (hasVnState s2 v:bool) then true else hasVnState s3 v + | AbsClosure s l => (fix go l := match l with + | (f::r) => if hasVnExp f v then true else go r + | nil => false + end) l + | _ => false + end. + +Fixpoint hasVarExp (e : absExp) (v : id) : bool := + match e with + | AbsConstVal v => false + | AbsVar vv => beq_id vv v + | AbsQVar vv => false + | AbsFun i l => (fix go l := match l with + | (f::r) => if hasVarExp f v then true else go r + | nil => false + end) l + end. + +Fixpoint hasVarState (s : absState) (v : id) : bool := + match s with + | AbsStar s1 s2 => if (hasVarState s1 v:bool) then true else hasVarState s2 v + | AbsOrStar s1 s2 => if (hasVarState s1 v:bool) then true else hasVarState s2 v + | AbsExistsT s => hasVarState s v + | AbsExists e s => if hasVarExp e v then true else hasVarState s v + | AbsAll e s => if hasVarExp e v then true else hasVarState s v + | AbsEach e s => if hasVarExp e v then true else hasVarState s v + | AbsLeaf i l => (fix go l := match l with + | (f::r) => if hasVarExp f v then true else go r + | nil => false + end) l + | AbsAccumulate id e1 e2 e3 => if hasVarExp e1 v then true else + if hasVarExp e2 v then true else + if hasVarExp e3 v then true else false + | AbsMagicWand s1 s2 => if (hasVarState s1 v:bool) then true else hasVarState s2 v + | AbsUpdateVar s vv vall => if (hasVarState s v:bool) then true else hasVarExp vall v + | AbsUpdateWithLoc s vv vall => if (hasVarState s v:bool) then true else hasVarExp vall v + | AbsUpdateLoc s l vall => if (hasVarState s v:bool) then true else if hasVarExp l v then true else hasVarExp vall v + | AbsUpdState s1 s2 s3 => if (hasVarState s1 v:bool) then true else + if (hasVarState s2 v:bool) then true else + hasVarState s3 v + | AbsClosure s l => (fix go l := match l with + | (f::r) => if hasVarExp f v then true else go r + | nil => false + end) l | _ => false end. -Inductive an_empty_state {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> Prop := +Fixpoint shareVarExpState (e : absExp) (s : absState) : bool := + match e with + | AbsConstVal v => false + | AbsVar vv => hasVarState s vv + | AbsQVar vv => false + | AbsFun i l => (fix go l := match l with + | (f::r) => if shareVarExpState f s then true else go r + | nil => false + end) l + end. + +Fixpoint shareVarState (s : absState) (v : absState) : bool := + match s with + | AbsStar s1 s2 => if (shareVarState s1 v:bool) then true else shareVarState s2 v + | AbsOrStar s1 s2 => if (shareVarState s1 v:bool) then true else shareVarState s2 v + | AbsExistsT s => shareVarState s v + | AbsExists e s => if shareVarExpState e v then true else shareVarState s v + | AbsAll e s => if shareVarExpState e v then true else shareVarState s v + | AbsEach e s => if shareVarExpState e v then true else shareVarState s v + | AbsLeaf i l => (fix go l := match l with + | (f::r) => if shareVarExpState f v then true else go r + | nil => false + end) l + | AbsAccumulate id e1 e2 e3 => if shareVarExpState e1 v then true else + if shareVarExpState e2 v then true else + if shareVarExpState e3 v then true else false + | AbsMagicWand s1 s2 => if (shareVarState s1 v:bool) then true else shareVarState s2 v + | AbsUpdateVar s vv vall => if (shareVarState s v:bool) then true else shareVarExpState vall v + | AbsUpdateWithLoc s vv vall => if (shareVarState s v:bool) then true else shareVarExpState vall v + | AbsUpdateLoc s l vall => if (shareVarState s v:bool) then true else if shareVarExpState l v then true else shareVarExpState vall v + | AbsUpdState s1 s2 s3 => if (shareVarState s1 v:bool) then true else + if (shareVarState s2 v:bool) then true else + shareVarState s3 v + | AbsClosure s l => (fix go l := match l with + | (f::r) => if shareVarExpState f v then true else go r + | nil => false + end) l + | _ => false + end. +Inductive an_empty_state : absState -> Prop := | ESCompose : forall p1 p2, an_empty_state p1 -> an_empty_state p2 -> @@ -574,7 +1218,7 @@ Inductive an_empty_state {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> Prop Ltac solveEmptyState := solve [(eapply ESCompose;solveEmptyState) | (eapply ESOrCompose;solveEmptyState) | eapply ESEmpty]. -Fixpoint removeExpVar {ev} {eq} {f} (v : nat) (e : @absExp ev eq f) : @absExp ev eq f := +Fixpoint removeExpVar (v : nat) (e : absExp) : absExp := match e with | AbsConstVal v => AbsConstVal v | AbsVar v => AbsVar v @@ -582,47 +1226,57 @@ Fixpoint removeExpVar {ev} {eq} {f} (v : nat) (e : @absExp ev eq f) : @absExp ev | AbsFun i l => AbsFun i (map (removeExpVar v) l) end. -Fixpoint removeStateVar {ev} {eq} {f} {t} {ac} (n : nat) (s : @absState ev eq f t ac) : @absState ev eq f t ac := +Fixpoint removeStateVar (n : nat) (s : absState) : absState := match s with | AbsStar s1 s2 => (AbsStar (removeStateVar n s1) (removeStateVar n s2)) | AbsOrStar s1 s2 => (AbsOrStar (removeStateVar n s1) (removeStateVar n s2)) - | AbsExistsT s => AbsExistsT (removeStateVar n s) - | AbsExists e s => AbsExists (removeExpVar n e) (removeStateVar n s) - | AbsAll e s => AbsAll (removeExpVar n e) (removeStateVar n s) - | AbsEach e s => AbsEach (removeExpVar n e) (removeStateVar n s) + | AbsExistsT s => AbsExistsT (removeStateVar (S n) s) + | AbsExists e s => AbsExists (removeExpVar n e) (removeStateVar (S n) s) + | AbsAll e s => AbsAll (removeExpVar n e) (removeStateVar (S n) s) + | AbsEach e s => AbsEach (removeExpVar n e) (removeStateVar (S n) s) | AbsEmpty => AbsEmpty + | AbsAny => AbsAny + | AbsNone => AbsNone | AbsLeaf i l => AbsLeaf i (map (removeExpVar n) l) | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (removeExpVar n e1) (removeExpVar n e2) (removeExpVar n e3) | AbsMagicWand s1 s2 => AbsMagicWand (removeStateVar n s1) (removeStateVar n s2) - | AbsUpdateVar s v vall => AbsUpdateVar (removeStateVar n s) v (removeExpVar n vall) + | AbsUpdateVar s v vall => AbsUpdateVar (removeStateVar n s) v (removeExpVar n vall) + | AbsUpdateWithLoc s v vall => AbsUpdateWithLoc (removeStateVar n s) v (removeExpVar n vall) + | AbsUpdateLoc s vv vall => AbsUpdateLoc (removeStateVar n s) (removeExpVar n vv) (removeExpVar n vall) | AbsUpdState s1 s2 s3 => (AbsUpdState (removeStateVar n s1) (removeStateVar n s2) (removeStateVar n s3)) + | AbsClosure s l => AbsClosure s (map (removeExpVar n) l) end. -Fixpoint addExpVar {ev} {eq} {f} (v : nat) (e : @absExp ev eq f) : @absExp ev eq f := +(*Fixpoint N (e : absExp) : absExp := match e with | AbsConstVal v => AbsConstVal v | AbsVar v => AbsVar v - | AbsQVar vv => if ble_nat v vv then AbsQVar (vv+1) else AbsQVar vv - | AbsFun i l => AbsFun i (map (addExpVar v) l) + | AbsQVar vv => AbsQVar (S vv) + | AbsFun i l => AbsFun i (map N l) end. -Fixpoint addStateVar {ev} {eq} {f} {t} {ac} (n : nat) (s : @absState ev eq f t ac) : @absState ev eq f t ac := +Fixpoint NS (s : absState) : absState := match s with - | AbsStar s1 s2 => (AbsStar (addStateVar n s1) (addStateVar n s2)) - | AbsOrStar s1 s2 => (AbsOrStar (addStateVar n s1) (addStateVar n s2)) - | AbsExistsT s => AbsExistsT (addStateVar n s) - | AbsExists e s => AbsExists (addExpVar n e) (addStateVar n s) - | AbsAll e s => AbsAll (addExpVar n e) (addStateVar n s) - | AbsEach e s => AbsEach (addExpVar n e) (addStateVar n s) + | AbsStar s1 s2 => (AbsStar (NS s1) (NS s2)) + | AbsOrStar s1 s2 => (AbsOrStar (NS s1) (NS s2)) + | AbsExistsT s => AbsExistsT (NS s) + | AbsExists e s => AbsExists (N e) (NS s) + | AbsAll e s => AbsAll (N e) (NS s) + | AbsEach e s => AbsEach (N e) (NS s) | AbsEmpty => AbsEmpty - | AbsLeaf i l => AbsLeaf i (map (addExpVar n) l) - | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (addExpVar n e1) (addExpVar n e2) (addExpVar n e3) - | AbsMagicWand s1 s2 => AbsMagicWand (addStateVar n s1) (addStateVar n s2) - | AbsUpdateVar s v vall => AbsUpdateVar (addStateVar n s) v (addExpVar n vall) - | AbsUpdState s1 s2 s3 => (AbsUpdState (addStateVar n s1) (addStateVar n s2) (addStateVar n s3)) - end. + | AbsAny => AbsAny + | AbsNone => AbsNone + | AbsLeaf i l => AbsLeaf i (map N l) + | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (N e1) (N e2) (N e3) + | AbsMagicWand s1 s2 => AbsMagicWand (NS s1) (NS s2) + | AbsUpdateVar s vv vall => AbsUpdateVar (NS s) vv (N vall) + | AbsUpdateWithLoc s vv vall => AbsUpdateWithLoc (NS s) vv (N vall) + | AbsUpdateLoc s vv vall => AbsUpdateLoc (NS s) (N vv) (N vall) + | AbsUpdState s1 s2 s3 => AbsUpdState (NS s1) (NS s2) (NS s3) + | AbsClosure s l => AbsClosure s (map N l) + end.*) -Fixpoint replaceExpVar {ev} {eq} {f} (v : nat) (rr : @absExp ev eq f) (e : @absExp ev eq f) : @absExp ev eq f := +Fixpoint replaceExpVar (v : nat) (rr : absExp) (e : absExp) : absExp := match e with | AbsConstVal v => AbsConstVal v | AbsVar v => AbsVar v @@ -630,23 +1284,28 @@ Fixpoint replaceExpVar {ev} {eq} {f} (v : nat) (rr : @absExp ev eq f) (e : @absE | AbsFun i l => AbsFun i (map (replaceExpVar v rr) l) end. -Fixpoint replaceStateVar {ev} {eq} {f} {t} {ac} (n : nat) (rr : @absExp ev eq f) (s : @absState ev eq f t ac) : @absState ev eq f t ac := +Fixpoint replaceStateVar (n : nat) (rr : absExp) (s : absState) : absState := match s with | AbsStar s1 s2 => (AbsStar (replaceStateVar n rr s1) (replaceStateVar n rr s2)) | AbsOrStar s1 s2 => (AbsOrStar (replaceStateVar n rr s1) (replaceStateVar n rr s2)) - | AbsExistsT s => AbsExistsT (replaceStateVar n rr s) - | AbsExists e s => AbsExists (replaceExpVar n rr e) (replaceStateVar n rr s) - | AbsAll e s => AbsAll (replaceExpVar n rr e) (replaceStateVar n rr s) - | AbsEach e s => AbsEach (replaceExpVar n rr e) (replaceStateVar n rr s) + | AbsExistsT s => AbsExistsT (replaceStateVar (S n) (addExpVar 0 rr) s) + | AbsExists e s => AbsExists (replaceExpVar n rr e) (replaceStateVar (S n) (addExpVar 0 rr) s) + | AbsAll e s => AbsAll (replaceExpVar n rr e) (replaceStateVar (S n) (addExpVar 0 rr) s) + | AbsEach e s => AbsEach (replaceExpVar n rr e) (replaceStateVar (S n) (addExpVar 0 rr) s) | AbsEmpty => AbsEmpty + | AbsAny => AbsAny + | AbsNone => AbsNone | AbsLeaf i l => AbsLeaf i (map (replaceExpVar n rr) l) | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (replaceExpVar n rr e1) (replaceExpVar n rr e2) (replaceExpVar n rr e3) | AbsMagicWand s1 s2 => AbsMagicWand (replaceStateVar n rr s1) (replaceStateVar n rr s2) - | AbsUpdateVar s v vall => AbsUpdateVar (replaceStateVar n rr s) v (replaceExpVar n rr vall) + | AbsUpdateVar s v vall => AbsUpdateVar (replaceStateVar n rr s) v (replaceExpVar n rr vall) + | AbsUpdateWithLoc s v vall => AbsUpdateWithLoc (replaceStateVar n rr s) v (replaceExpVar n rr vall) + | AbsUpdateLoc s v vall => AbsUpdateLoc (replaceStateVar n rr s) (replaceExpVar n rr v) (replaceExpVar n rr vall) | AbsUpdState s1 s2 s3 => (AbsUpdState (replaceStateVar n rr s1) (replaceStateVar n rr s2) (replaceStateVar n rr s3)) + | AbsClosure s l => AbsClosure s (map (replaceExpVar n rr) l) end. -Fixpoint replaceExpExp {ev} {eq} {f} (v : @absExp ev eq f) (rr : @absExp ev eq f) (e : @absExp ev eq f) : @absExp ev eq f := +Fixpoint replaceExpExp (v : absExp) (rr : absExp) (e : absExp) : absExp := if beq_absExp v e then rr else match e with | AbsConstVal v => AbsConstVal v @@ -655,7 +1314,7 @@ Fixpoint replaceExpExp {ev} {eq} {f} (v : @absExp ev eq f) (rr : @absExp ev eq f | AbsFun i l => AbsFun i (map (replaceExpExp v rr) l) end. -Fixpoint replaceStateExp {ev} {eq} {f} {t} {ac} (v : @absExp ev eq f) (rr : @absExp ev eq f) (s : @absState ev eq f t ac) : @absState ev eq f t ac := +Fixpoint replaceStateExp (v : absExp) (rr : absExp) (s : absState) : absState := match s with | AbsStar s1 s2 => (AbsStar (replaceStateExp v rr s1) (replaceStateExp v rr s2)) | AbsOrStar s1 s2 => (AbsOrStar (replaceStateExp v rr s1) (replaceStateExp v rr s2)) @@ -664,36 +1323,47 @@ Fixpoint replaceStateExp {ev} {eq} {f} {t} {ac} (v : @absExp ev eq f) (rr : @abs | AbsAll e s => AbsAll (replaceExpExp v rr e) (replaceStateExp v rr s) | AbsEach e s => AbsEach (replaceExpExp v rr e) (replaceStateExp v rr s) | AbsEmpty => AbsEmpty + | AbsAny => AbsAny + | AbsNone => AbsNone | AbsLeaf i l => AbsLeaf i (map (replaceExpExp v rr) l) | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (replaceExpExp v rr e1) (replaceExpExp v rr e2) (replaceExpExp v rr e3) | AbsMagicWand s1 s2 => AbsMagicWand (replaceStateExp v rr s1) (replaceStateExp v rr s2) | AbsUpdateVar s vv vall => AbsUpdateVar (replaceStateExp v rr s) vv (replaceExpExp v rr vall) + | AbsUpdateWithLoc s vv vall => AbsUpdateWithLoc (replaceStateExp v rr s) vv (replaceExpExp v rr vall) + | AbsUpdateLoc s vv vall => AbsUpdateLoc (replaceStateExp v rr s) (replaceExpExp v rr vv) (replaceExpExp v rr vall) | AbsUpdState s1 s2 s3 => (AbsUpdState (replaceStateExp v rr s1) (replaceStateExp v rr s2) (replaceStateExp v rr s3)) + | AbsClosure s l => AbsClosure s (map (replaceExpExp v rr) l) end. -Fixpoint N {ev} {eq} {f} (e : @absExp ev eq f) : @absExp ev eq f := +(*Fixpoint P (e : absExp) : absExp := match e with | AbsConstVal v => AbsConstVal v | AbsVar v => AbsVar v - | AbsQVar vv => AbsQVar (S vv) - | AbsFun i l => AbsFun i (map N l) + | AbsQVar 0 => AbsQVar 0 + | AbsQVar (S vv) => AbsQVar vv + | AbsFun i l => AbsFun i (map P l) end. -Fixpoint NS {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : @absState ev eq f t ac := +Fixpoint PS (s : absState) : absState := match s with - | AbsStar s1 s2 => (AbsStar (NS s1) (NS s2)) - | AbsOrStar s1 s2 => (AbsOrStar (NS s1) (NS s2)) - | AbsExistsT s => AbsExistsT (NS s) - | AbsExists e s => AbsExists (N e) (NS s) - | AbsAll e s => AbsAll (N e) (NS s) - | AbsEach e s => AbsEach (N e) (NS s) + | AbsStar s1 s2 => (AbsStar (PS s1) (PS s2)) + | AbsOrStar s1 s2 => (AbsOrStar (PS s1) (PS s2)) + | AbsExistsT s => AbsExistsT (PS s) + | AbsExists e s => AbsExists (P e) (PS s) + | AbsAll e s => AbsAll (P e) (PS s) + | AbsEach e s => AbsEach (P e) (PS s) | AbsEmpty => AbsEmpty - | AbsLeaf i l => AbsLeaf i (map N l) - | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (N e1) (N e2) (N e3) - | AbsMagicWand s1 s2 => AbsMagicWand (NS s1) (NS s2) - | AbsUpdateVar s vv vall => AbsUpdateVar (NS s) vv (N vall) - | AbsUpdState s1 s2 s3 => AbsUpdState (NS s1) (NS s2) (NS s3) - end. + | AbsAny => AbsAny + | AbsNone => AbsNone + | AbsLeaf i l => AbsLeaf i (map P l) + | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (P e1) (P e2) (P e3) + | AbsMagicWand s1 s2 => AbsMagicWand (PS s1) (PS s2) + | AbsUpdateVar s vv vall => AbsUpdateVar (PS s) vv (P vall) + | AbsUpdateWithLoc s vv vall => AbsUpdateWithLoc (PS s) vv (P vall) + | AbsUpdateLoc s vv vall => AbsUpdateLoc (PS s) (P vv) (P vall) + | AbsUpdState s1 s2 s3 => AbsUpdState (PS s1) (PS s2) (PS s3) + | AbsClosure s l => AbsClosure s (map P l) + end.*) (*************************************************************************************** * @@ -718,7 +1388,7 @@ Fixpoint NS {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : @absState ev e * ***************************************************************************************) -Definition supportsFunctionality ev eq (f : id -> list (@Value ev) -> (@Value ev)) (f_count : nat) +(*Definition supportsFunctionality ev eq (f : id -> list (@Value ev) -> (@Value ev)) (f_count : nat) (t : id -> list (@Value ev) -> heap -> Prop) (t_count : nat) (ac : id -> (id -> nat) -> (list (@Value ev)) -> (list (@Value ev)) -> (@absExp ev eq f) -> @Value ev -> Prop) (ac_count : nat) @@ -732,7 +1402,7 @@ Definition supportsFunctionality ev eq (f : id -> list (@Value ev) -> (@Value ev (forall (i : nat) (vl : list (@Value ev)) (env : id -> nat) (b : list (@Value ev)) (e : @absExp ev eq f) (v : @Value ev), ac (Id i) env b vl e v -> i < ac_count -> ac' (Id i) env (map (convertAbsValue rfun) b) (map (convertAbsValue rfun) vl) (convertAbsExp rfun e) (convertAbsValue rfun v)) /\ (forall (i : nat) (env : id -> nat) (b : list (@Value ev')) (vl : list (@Value ev')) (e : @absExp ev' eq' f') (v : @Value ev'), - ac' (Id i) env b vl e v -> i < ac_count -> ac (Id i) env (map (convertAbsValue mfun) b) (map (convertAbsValue mfun) vl) (convertAbsExp mfun e) (convertAbsValue mfun v)). + ac' (Id i) env b vl e v -> i < ac_count -> ac (Id i) env (map (convertAbsValue mfun) b) (map (convertAbsValue mfun) vl) (convertAbsExp mfun e) (convertAbsValue mfun v)).*) (*************************************************************************************** * @@ -751,8 +1421,8 @@ Proof. intros. unfold compose_heaps. extensionality x. rewrite H. reflexivity. Qed. -(*Theorem composeEmptyRight {ev} {eq} {f} {t} {ac} : - forall (s : @absState ev eq f t ac) state bindings, +(*Theorem composeEmptyRight : + forall (s : absState ev eq f t ac) state bindings, realizeState (AbsStar s AbsEmpty) bindings state <-> realizeState s bindings state. Proof. crunch. inversion H. subst. clear H. inversion H3. subst. clear H3. @@ -851,6 +1521,134 @@ Proof. crunch. rewrite <- H3. unfold compose_heaps. crunch. caseAnalysis. Qed.*) +Fixpoint subVarList vv (l : list absExp):= + match l with + | (ff::r) => match vv with + | 0 => ff + | S n => subVarList n r + end + | nil => v(vv) + end. + +Fixpoint subExpList (e : absExp) (l : list absExp) := + match e with + | AbsConstVal v => AbsConstVal v + | AbsVar v => AbsVar v + | AbsQVar v => subVarList v l + | AbsFun i ll => AbsFun i (map (fun x => subExpList x l) ll) + end. + +Fixpoint subStateList (s : absState) (l : list absExp) : absState := + match s with + | AbsStar s1 s2 => (AbsStar (subStateList s1 l) (subStateList s2 l)) + | AbsOrStar s1 s2 => (AbsOrStar (subStateList s1 l) (subStateList s2 l)) + | AbsExistsT s => AbsExistsT (subStateList s (v(0)::(map (addExpVar 0) l))) + | AbsExists e s => AbsExists (subExpList e l) (subStateList s (v(0)::(map (addExpVar 0) l))) + | AbsAll e s => AbsAll (subExpList e l) (subStateList s (v(0)::(map (addExpVar 0) l))) + | AbsEach e s => AbsEach (subExpList e l) (subStateList s (v(0)::(map (addExpVar 0) l))) + | AbsEmpty => AbsEmpty + | AbsAny => AbsAny + | AbsNone => AbsNone + | AbsLeaf i ll => AbsLeaf i (map (fun ee => subExpList ee l) ll) + | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (subExpList e1 l) (subExpList e2 l) (subExpList e3 l) + | AbsMagicWand s1 s2 => AbsMagicWand (subStateList s1 l) (subStateList s2 l) + | AbsUpdateVar s vv vall => AbsUpdateVar (subStateList s l) vv (subExpList vall l) + | AbsUpdateWithLoc s vv vall => AbsUpdateWithLoc (subStateList s l) vv (subExpList vall l) + | AbsUpdateLoc s vv vall => AbsUpdateLoc (subStateList s l) (subExpList vv l) (subExpList vall l) + | AbsUpdState s1 s2 s3 => (AbsUpdState (subStateList s1 l) (subStateList s2 l) (subStateList s3 l)) + | AbsClosure s ll => AbsClosure s (map (fun x => subExpList x l) ll) + end. + +Fixpoint expHeight (e : absExp) : nat := + match e with + | AbsConstVal v => 0 + | AbsVar v => 0 + | AbsQVar v => (S v) + | AbsFun i l => fold_left (fun n e => (n+e)) (map expHeight l) 0 + end. + +Fixpoint hasVarExpList (l : list absExp) (v : id) := + match l with + | (a::b) => if hasVarExp a v then true else hasVarExpList b v + | nil => false + end. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/AbsStateInstance.v b/PEDANTIC/AbsStateInstance.v index ee9cbd1..99ca414 100644 --- a/PEDANTIC/AbsStateInstance.v +++ b/PEDANTIC/AbsStateInstance.v @@ -36,146 +36,6 @@ Require Export AbsState. * lists. **********************************************************************************) -Inductive anyHeap : nat -> nat -> heap -> Prop := - | AnyHeapBase : forall start, - anyHeap start 0 (fun x => None) - | AnyHeapNext : forall start next heap y, - anyHeap (S start) next heap -> - anyHeap start (S next) (fun x => if beq_nat x start then Some y else heap x). - -Inductive Rcell : nat -> (list nat) -> heap -> nat -> Prop := - | RCellBase : forall l ll h, - Rcell l ll h l - | RCellNext : forall l ll index h n nn, - mem_nat index ll=true -> - h (n+index)=Some nn -> - Rcell l ll h n -> - Rcell l ll h nn. - -Inductive mergeHeaps : (list heap) -> heap -> Prop := - | MHBase : mergeHeaps nil (fun x => None) - | MHNext : forall f r h1 h2 h, - mergeHeaps r h2 -> - (forall x, h1 x=None \/ h2 x=None) -> - h = (fun x => match h1 x with None => h2 x | Some x => Some x end) -> - mergeHeaps (f::r) h. - -Inductive heapWithIndexList {t} : (list nat) -> (list heap) -> (list (@Value t)) -> (list (nat * heap * (@Value t))) -> Prop := - | HWIBase : heapWithIndexList nil nil nil nil - | HWINext : forall ir hr ihr br i h b, - heapWithIndexList ir hr br ihr -> - heapWithIndexList (i::ir) (h::hr) (b::br) ((i,h,b)::ihr). - -Fixpoint findIndex {t} (n : nat) (h : heap) (l : list (nat * heap * (@Value t))) : @Value t := - match l with - | nil => match h n with - | Some x => NatValue x - | None => NatValue 0 - end - | ((nn,hh,v)::r) => if beq_nat n nn then v else findIndex n h r - end. - -Fixpoint buildList {t} (i : nat) (size : nat) (h : heap) (l : list (nat * heap * (@Value t))) : list (@Value t) := - match size with - | 0 => nil - | (S s) => (findIndex i h l)::(buildList (S i) s h l) - end. - -Inductive ihmem {t} : nat -> heap -> @Value t -> (list (nat * heap * (@Value t))) -> Prop := - | IHBase : forall n h v hl, - ihmem n h v ((n,h,v)::hl) - | IHNext : forall n h v f hl, - ihmem n h v hl -> - ihmem n h v (f::hl). - -(* - * Recursive definition for the TREE construct--used in the definition of basicState - * - * Parameters: - * #1 - root of tree - * #2 - size of each node in the tree - * #3 - list of offsets to fields for each node - * #4 - functional representation of the tree - * #5 - concrete heap (Must be exact heap for the tree) - *) -Inductive Tree {t} : nat -> nat -> (list nat) -> (@Value t) -> heap -> Prop := - | TreeNext : forall root size indices heaps ihlist h0 h1 heap values vals, - size > 0 -> - anyHeap root size h0 -> - heapWithIndexList indices heaps values ihlist -> - not(root=0) -> - (forall i h v x, ihmem i h v ihlist -> Some x=h0 (root+x) -> Tree x size indices v h) -> - mergeHeaps heaps h1 -> - (forall l, (h1 l=None \/ h0 l=None)) -> - heap = (fun x => match h1 x with None => h0 x | Some x => Some x end) -> - vals = buildList root size heap ihlist -> - Tree root size indices (ListValue ((NatValue root)::vals)) heap - | TreeBase : forall size index h, - size > 0 -> - (forall v, h v=None) -> - Tree 0 size index (ListValue ((NatValue 0)::nil)) h. - -Fixpoint flatten {t} (v : @Value t) (loc : nat) : list ((@Value t) * nat) := - match v with - | (ListValue ((NatValue loc)::ll)) => - (v,loc)::((fix go (x : list (@Value t)) l := - match x with - | (f::r) => (flatten f l)++(go r (l+1)) - | _ => nil - end) ll loc) - | x => (v,loc)::nil - end. - -Fixpoint rmemberFullList {t} (n : nat) (v : (list ((@Value t) * nat))) : bool := - match v with - | ((val,loc)::r) => if beq_nat loc n then true else rmemberFullList n r - | _ => false - end. - -Fixpoint rmemberList {t} (n : nat) (v : (list ((@Value t) * nat))) : bool := - match v with - | ((ListValue ((NatValue xx)::ll),loc)::r) => if beq_nat loc n then true else rmemberList n r - | (_::r) => rmemberList n r - | _ => false - end. - -(* - * Rmember is a predicate used in AbsPredicate constructs to determine whether a nat - * is in fact a pointer to the head of any of the nodes in the list or tree represented - * by an RFun construct. - * - * Parameters: - * l - location to test - * tree - a tree (which is the same form as parameter #4 to tree above - * - * This definition is used in basicEval for the 'inTree' function - *) -Definition Rmember {t} (l : nat) (tree : @Value t) : bool := - rmemberList l (flatten tree 0). - -(*Theorem rootIsMember : forall root size fields heap, - root <> 0 -> - R root size fields heap -> - Rmember root root fields heap. -Proof. adxxmit. Qed.*) - -(* - * Rinclude is the same as Rmember except that it tests whether the location is a pointer to - * any cell within a node rather than just the first. It is used for 'inTreeLoc' defined in - * basicEval - * - * Parameters: - * l - location to test - * tree - a tree (which is the same form as parameter #4 to tree above - *) -Definition Rinclude {t} (l : nat) (tree : @Value t) : bool := - rmemberFullList l (flatten tree 0). - -Inductive strip_nat_values {t} : (list (@Value t)) -> (list nat) -> Prop := - | SNVNil : strip_nat_values nil nil - | SNVCons : forall v a b, - strip_nat_values a b -> - strip_nat_values ((NatValue v)::a) (v::b). Ltac simplifyStripNatValues := match goal with @@ -188,148 +48,15 @@ Ltac simplifyStripNatValues := (*Hint Immediate SNVNil.*) Hint Constructors strip_nat_values. -Fixpoint findRecord {t} (l : nat) (v : @Value t) := - match v with - | (ListValue ((NatValue x)::r)) => - if beq_nat x l then - (ListValue ((NatValue x)::r)) - else (fix go ll := - match ll with - | nil => NoValue - | (f::r) => match findRecord l f with - | NoValue => go r - | x => x - end - end) r - | _ => NoValue - end. -Inductive valueIndexList {t} : (list nat) -> (list (@Value t)) -> (list (nat * (@Value t))) -> Prop := - | VIBase : valueIndexList nil nil nil - | VINext : forall ir br i b ibr, - valueIndexList ir br ibr -> - valueIndexList (i::ir) (b::br) ((i,b)::ibr). - -Inductive imem {t} : nat -> @Value t -> (list (nat * (@Value t))) -> Prop := - | IBase : forall n v hl, - imem n v ((n,v)::hl) - | INext : forall n v f hl, - imem n v hl -> - imem n v (f::hl). - -Inductive updateRec {t} : (list (nat * (@Value t))) -> nat -> list (@Value t) -> list (@Value t) -> Prop := - | UBase : forall n vl, - updateRec vl n nil nil - | UMem : forall n v vl or nr x, - imem n v vl -> - updateRec vl (n+1) or nr -> - updateRec vl n (x::or) (v::nr) - | UDef1 : forall n v vl or nr x, - not(imem n v vl) -> - updateRec vl (n+1) or nr -> - updateRec vl n ((NatValue x)::or) ((NatValue x)::or) - | UDef2 : forall n v vl or nr x rr, - not(imem n v vl) -> - updateRec vl (n+1) or nr -> - updateRec vl n ((ListValue ((NatValue x)::rr))::or) ((NatValue x)::or). - -Inductive Path {t} : nat -> nat -> (list nat) -> (@Value t) -> (@Value t) -> Prop := - | PathNext : forall root size indices baseData rec vals ivals rec2, - size > 0 -> - not(root=0) -> - (ListValue ((NatValue root)::rec)) = findRecord root baseData -> - valueIndexList indices vals ivals -> - (forall i x v r, imem i v ivals -> ((ListValue ((NatValue x)::r))=nth i rec NoValue /\ Path x size indices baseData v)) -> - updateRec ivals 0 rec rec2 -> - Path root size indices baseData (ListValue (NatValue root::rec2)) - | PathBase : forall size l h, - size > 0 -> - Path 0 size l h (ListValue ((NatValue 0)::nil)). - -Fixpoint rangeSet {t} (v : @Value t) : @Value t := - match v with - | (ListValue (NatValue loc::r)) => - (fix go (x : (list (@Value t))) := - match x with - | (f::l) => match (rangeSet f,go l) with - | ((ListValue l),(ListValue y)) => (ListValue (l++y)) - | _ => NoValue - end - | _ => (ListValue nil) - end) r - | (NatValue _) => (ListValue nil) - | _ => NoValue - end. -Fixpoint numericRange {t} (s : nat) (e : nat) : @Value t := - if beq_nat s e then (ListValue nil) - else match e with - | 0 => (ListValue (nil)) - | (S e') => match numericRange s e' with - (ListValue l) => (ListValue (l++((NatValue e')::nil))) - | _ => NoValue - end - end. - -Fixpoint replacenth {t} (l : list t) (n : nat) (e : t) := - match l,n with - | (f::r),0 => (e::r) - | (f::r),(S n1) => (f::(replacenth r n1 e)) - | l,_ => l - end. -(*************************************************************************** - * - * basicEval - * - * This is used to fill in the 'f' parameter in absExp. - * - ***************************************************************************) -Notation "'AbsNthId'" := (Id 1) (at level 1). -Notation "'AbsPlusId'" := (Id 2) (at level 1). -Notation "'AbsMinusId'" := (Id 3) (at level 1). -Notation "'AbsTimesId'" := (Id 4) (at level 1). -Notation "'AbsEqualId'" := (Id 5) (at level 1). -Notation "'AbsLessId'" := (Id 6) (at level 1). -Notation "'AbsMemberId'" := (Id 7) (at level 1). -Notation "'AbsIncludeId'" := (Id 8) (at level 1). -Notation "'AbsImplyId'" := (Id 9) (at level 1). -Notation "'AbsNotId'" := (Id 10) (at level 1). -Notation "'AbsAndId'" := (Id 11) (at level 1). -Notation "'AbsOrId'" := (Id 12) (at level 1). -Notation "'AbsIteId'" := (Id 13) (at level 1). -Notation "'AbsFindId'" := (Id 14) (at level 1). -Notation "'AbsListId'" := (Id 15) (at level 1). -Notation "'AbsRangeSetId'" := (Id 16) (at level 1). -Notation "'AbsRangeNumericId'" := (Id 17) (at level 1). -Notation "'AbsReplaceNthId'" := (Id 18) (at level 1). - -Fixpoint basicEval {t} (op : id) (args : list (@Value t)) : @Value t := - match (op,args) with - | (AbsNthId,((ListValue l)::(NatValue f)::nil)) => nth f l NoValue - | (AbsPlusId,((NatValue l)::(NatValue r)::nil)) => (NatValue (l+r)) - | (AbsMinusId,((NatValue l)::(NatValue r)::nil)) => (NatValue (l-r)) - | (AbsTimesId,((NatValue l)::(NatValue r)::nil)) => (NatValue (l*r)) - | (AbsEqualId,((NatValue l)::(NatValue r)::nil)) => if beq_nat l r then (NatValue 1) else (NatValue 0) - | (AbsLessId,((NatValue l)::(NatValue r)::nil)) => if ble_nat r l then (NatValue 0) else (NatValue 1) - | (AbsMemberId,((NatValue l)::tree::nil)) => if Rmember l tree then (NatValue 1) else (NatValue 0) - | (AbsIncludeId,((NatValue l)::tree::nil)) => if Rinclude l tree then (NatValue 1) else (NatValue 0) - | (AbsImplyId,((NatValue l)::r::nil)) => if beq_nat l 0 then NatValue 1 else r - | (AbsNotId,((NatValue l)::nil)) => if beq_nat l 0 then NatValue 1 else NatValue 0 - | (AbsAndId,((NatValue l)::r::nil)) => if beq_nat l 0 then NatValue 0 else r - | (AbsOrId,((NatValue l)::r::nil)) => if beq_nat l 0 then r else (NatValue l) - | (AbsIteId,((NatValue c)::t::e::nil)) => if beq_nat c 0 then e else t - | (AbsFindId,(v::(NatValue x)::nil)) => @findRecord t x v - | (AbsListId,l) => @ListValue t l - | (AbsRangeSetId,(f::nil)) => rangeSet f - | (AbsRangeNumericId,((NatValue s)::(NatValue e)::nil)) => numericRange s e - | (AbsReplaceNthId,((ListValue l)::(NatValue n)::e::nil)) => (ListValue (replacenth l n e)) - | _ => NoValue - end. + + (* This function is used in absExecute in defining (and proving) many tactics *) -Fixpoint convertToAbsExp {ev} {eq} {f} (e : aexp) : @absExp ev eq f := +Fixpoint convertToAbsExp (e : aexp) : absExp := match e with | ANum v => AbsConstVal (NatValue v) | AVar id => AbsVar id @@ -343,89 +70,20 @@ Fixpoint convertToAbsExp {ev} {eq} {f} (e : aexp) : @absExp ev eq f := | ALnot t => AbsFun (Id 10) ((convertToAbsExp t)::nil) end. -(*************************************************************************** - * - * basicState - * - * This is used to fill in the 't' parameter in absState. - * - ***************************************************************************) -Notation "'AbsPredicateId'" := (Id 1) (at level 1). -Notation "'AbsTreeId'" := (Id 2) (at level 1). -Notation "'AbsCellId'" := (Id 3) (at level 1). -Notation "'AbsArrayId'" := (Id 4) (at level 1). -Notation "'AbsPathId'" := (Id 5) (at level 1). - -Inductive anyHeapv {t} : nat -> nat -> heap -> (list (@Value t)) -> Prop := - | AnyHeapvBase : forall start, - anyHeapv start 0 (fun x => None) nil - | AnyHeapvNext : forall start next heap y r, - anyHeapv (S start) next heap r -> - anyHeapv start (S next) (fun x => if beq_nat x start then Some y else heap x) - ((NatValue y)::r). - -Inductive basicState {t} : id -> list (@Value t) -> heap -> Prop := - | BTStatePredicate : forall e h, - e<>0 -> - (forall x, h x = None) -> - basicState AbsPredicateId ((NatValue e)::nil) h - | BStateTree : forall r s f h ff tt, - Tree r s f tt h -> - strip_nat_values ff f -> - basicState AbsTreeId ((NatValue r)::tt::(NatValue s)::ff) h - | BStatePath : forall r s f base path h ff, - Path r s f base path -> - strip_nat_values ff f -> - (forall x, h x = None) -> - basicState AbsPathId ((NatValue r)::base::path::(NatValue s)::ff) h - | BStateArray : forall r s h vl, - anyHeapv r s h vl-> - basicState AbsArrayId ((NatValue r)::(NatValue s)::(ListValue vl)::nil) h - | BTStateCell : forall v l h, - h l = Some v -> - l<>0 -> - (forall x, x<>l -> h x=None) -> - basicState AbsCellId ((NatValue l)::(NatValue v)::nil) h. - -Notation "'[' x ']'" := (AbsLeaf (Id 1) (x::nil)) +Notation "'[' x ']'" := (AbsLeaf (Id 101) (x::nil)) (at level 20). -Notation "x '|->' y" := (AbsLeaf (Id 3) (x::y::nil)) +Notation "x '|->' y" := (AbsLeaf (Id 103) (x::y::nil)) (at level 20). -Notation "'TREE(' r ',' f ',' s ',' l ')'" := (AbsLeaf (Id 2) (r::f::s::l)) +Notation "'TREE(' r ',' f ',' s ',' l ')'" := (AbsLeaf (Id 102) (r::f::s::l)) (at level 20). -Notation "'Path(' r ',' f ',' p ',' s ',' l ')'" := (AbsLeaf (Id 5) (r::f::p::s::l)) +Notation "'Path(' r ',' f ',' p ',' s ',' l ')'" := (AbsLeaf (Id 105) (r::f::p::s::l)) (at level 20). -Notation "'ARRAY(' r ',' s ',' v ')'" := (AbsLeaf (Id 4) (r::s::v::nil)) +Notation "'ARRAY(' r ',' s ',' v ')'" := (AbsLeaf (Id 104) (r::s::v::nil)) (at level 20). -(*************************************************************************** - * - * basicAccumulate - * - * This is used to fill in the 'ac' parameter in absState. For now, this is - * a place holder. There are no actual definitions. - * - ***************************************************************************) - -Notation "'AbsSumId'" := (Id 1) (at level 1). - -Inductive sumValues {t} {teq} {f} : (id -> nat) -> (list (@Value t)) -> (list (@Value t)) -> (@absExp t teq f) -> (@Value t) -> Prop := - | SumNil : forall b e env, - sumValues env b nil e (NatValue 0) - | SumCons : forall b e x ff r env y v, - sumValues env b r e (NatValue x) -> - absEval env (b++(ff::nil)) e = NatValue v -> - y = x+v -> - sumValues env b (ff::r) e (NatValue y). -Inductive basicAccumulate {t} {teq} {f} : id -> (id -> nat) -> (list (@Value t)) -> (list (@Value t)) -> - (@absExp t teq f) -> - (@Value t) -> Prop := - | BASum : forall env b e l tt, - sumValues env b l e tt -> - basicAccumulate AbsSumId env b l e tt. Notation "'SUM(' e ',' f ',' t ')'" := (AbsAccumulate AbsSumId e f t) (at level 20). @@ -441,7 +99,7 @@ Notation "'SUM(' e ',' f ',' t ')'" := (AbsAccumulate AbsSumId e f t) (at level * ***************************************************************************) -Definition absExpBasicF {t} {teq} := @absExp t teq (@basicEval t). +(*Definition absExpBasicF {t} {teq} := @absExp t teq (@basicEval t). Definition absStateBasicF {t} {teq} {f} := @absState t teq f (@basicState t) (@basicAccumulate t teq f). @@ -451,7 +109,7 @@ Opaque unitEval. Definition eq_unit (a : unit) (b : unit) := true. Definition absExpBasic := @absExpBasicF unit eq_unit. -Definition absStateBasic := @absState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)). +Definition absStateBasic := @absState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)).*) (************************************************************************* * @@ -525,6 +183,27 @@ Notation "'replacenth(' d ',' n ',' e ')'" := (AbsFun (Id 18) (d::n::e::nil)) * ****************************************************************************) -Definition supportsBasicFunctionality ev eq f t ac v:= +(*Definition supportsBasicFunctionality v:= supportsFunctionality unit eq_unit (@basicEval unit) 18 basicState 4 (@basicAccumulate unit eq_unit (@basicEval unit)) 0 - ev eq f t ac (fun (x:ev) => tt) (fun x => (v:ev)). + ev eq f t ac (fun (x:ev) => tt) (fun x => (v:ev)).*) + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/ClosureHelper.v b/PEDANTIC/ClosureHelper.v new file mode 100644 index 0000000..b0878e5 --- /dev/null +++ b/PEDANTIC/ClosureHelper.v @@ -0,0 +1,87 @@ +(********************************************************************************** + * The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic + * Traversal of Instruction Code) verification framework + * + * Developed by Kenneth Roe + * For more information, check out www.cs.jhu.edu/~roe + * + * ClosureHelper.v + * + **********************************************************************************) + +Require Export SfLib. +Require Export SfLibExtras. +Require Export ImpHeap. +Require Export AbsState. +Require Export AbsExecute. +Require Export AbsStateInstance. +Require Export Simplify. +Require Export Eqdep. +Require Export StateImplication. +Require Export Classical. +Require Export Unfold. +Require Export Fold. +Require Export merge. +Require Export ProgramTactics. + +Theorem breakClosure : forall bindings s state param ss, + ss = subStateList state param -> + (realizeState (AbsClosure state param) bindings s <-> realizeState ss bindings s). +Proof. + admit. +Admitted. + +Fixpoint breakTopClosure (s : absState) : absState := + match s with + | AbsStar s1 s2 => (AbsStar (breakTopClosure s1) (breakTopClosure s2)) + | AbsOrStar s1 s2 => (AbsOrStar (breakTopClosure s1) (breakTopClosure s2)) + | AbsExistsT s => AbsExistsT (breakTopClosure s) + | AbsExists e s => AbsExists e (breakTopClosure s) + | AbsAll e s => AbsAll e (breakTopClosure s) + | AbsEach e s => AbsEach e (breakTopClosure s) + | AbsEmpty => AbsEmpty + | AbsAny => AbsAny + | AbsNone => AbsNone + | AbsLeaf i ll => AbsLeaf i ll + | AbsAccumulate id e1 e2 e3 => AbsAccumulate id e1 e2 e3 + | AbsMagicWand s1 s2 => AbsMagicWand (breakTopClosure s1) (breakTopClosure s2) + | AbsUpdateVar s vv vall => AbsUpdateVar (breakTopClosure s) vv vall + | AbsUpdateWithLoc s vv vall => AbsUpdateWithLoc (breakTopClosure s) vv vall + | AbsUpdateLoc s vv vall => AbsUpdateLoc (breakTopClosure s) vv vall + | AbsUpdState s1 s2 s3 => (AbsUpdState (breakTopClosure s1) (breakTopClosure s2) (breakTopClosure s3)) + | AbsClosure s ll => subStateList s ll + end. + +Theorem breakTopClosureThm1 : forall bindings s state1 state2, + state1 = breakTopClosure state2 -> + (realizeState state1 bindings s -> realizeState state2 bindings s). +Proof. + admit. +Admitted. + +Theorem breakTopClosureThm2 : forall bindings s state1 state2, + state1 = breakTopClosure state2 -> + (realizeState state2 bindings s -> realizeState state1 bindings s). +Proof. + admit. +Admitted. + +Theorem breakLeftClosureThm : forall left1 left2 right m, + left1 = breakTopClosure left2 -> + mergeStates left1 right m -> mergeStates left2 right m. +Proof. + admit. +Admitted. + +Theorem breakRightClosureThm : forall left right1 right2 m, + right1 = breakTopClosure right2 -> + mergeStates left right1 m -> mergeStates left right2 m. +Proof. + admit. +Admitted. + + + + + + diff --git a/PEDANTIC/Fold.v b/PEDANTIC/Fold.v index aa1070b..6b6368a 100644 --- a/PEDANTIC/Fold.v +++ b/PEDANTIC/Fold.v @@ -22,7 +22,6 @@ Require Export AbsStateInstance. Require Export PickElement. Require Export AbsExecute. Require Export Coq.Logic.FunctionalExtensionality. -Opaque unitEval. (* * pickNCells picks out the cells that are to be included in the folded RFun term. It also generates @@ -35,24 +34,28 @@ Opaque unitEval. * #4 : absExp - root of folded tree * #5 : list absState - output of the list of cells picked *) -Inductive pickNCells {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> @absState ev eq f t ac -> nat -> @absExp ev eq f -> list (@absState ev eq f t ac) -> Prop := +Inductive pickNCells : absState -> absState -> nat -> absExp -> list absState -> Prop := | PNCBase : forall state root, pickNCells state state 0 root nil - | PNCInductive : forall state state1 state2 size root v cells, + | PNCInductive0 : forall state state1 state2 root v cells, + spickElement state (root |-> v) state1 -> + pickNCells state1 state2 0 root cells -> + pickNCells state state2 (S 0) root (cells++(root++++#0 |-> v)::nil) | PNCInductive : forall state state1 state2 size root v cells, spickElement state (root++++#size |-> v) state1 -> pickNCells state1 state2 size root cells -> pickNCells state state2 (S size) root (cells++(root++++#size |-> v)::nil). Hint Constructors pickNCells. -Ltac pickNCells := (eapply PNCBase || (eapply PNCInductive;[solveSPickElement | pickNCells])). +Ltac pickNCells := (eapply PNCBase || (eapply PNCInductive0;[solveSPickElement | pickNCells]) || (eapply PNCInductive;[solveSPickElement | pickNCells])). -Inductive strip_fields {ev} {eq} {f} : list (@absExp ev eq f) -> list nat -> Prop := +Inductive strip_fields : list absExp -> list nat -> Prop := | SFNil : strip_fields nil nil | SFCons : forall n r1 r2, strip_fields r1 r2 -> strip_fields ((#n)::r1) (n::r2). Hint Constructors strip_fields. +Ltac stripFields := ((eapply SFCons;stripFields) || eapply SFNil). (* * pickNHeaps picks out the heaps that are to be included in the folded RFun term. It also generates * a portion of the predicate used to map the original components to the folded components @@ -66,7 +69,7 @@ Hint Constructors strip_fields. * #6 : list (nat * absState) - output of the list of heaps picked (associated with their field * offset) *) -Inductive pickNHeaps {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> @absState ev eq f t ac -> (list nat) -> nat -> list nat -> list (@absState ev eq f t ac)-> list (nat * (@absState ev eq f t ac)) -> Prop := +Inductive pickNHeaps : absState -> absState -> (list nat) -> nat -> list nat -> list (absState)-> list (nat * (absState)) -> Prop := | PNHBase : forall state size fields cells, pickNHeaps state state nil size fields cells nil | PNHInductive : forall state state1 state2 base fff r root ff fields cells size heap hr e_fields, @@ -77,17 +80,17 @@ Inductive pickNHeaps {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> @absStat pickNHeaps state state2 (fff::r) size e_fields cells ((fff,TREE(base,v(heap),#size,fields))::hr). Hint Constructors pickNHeaps. -Ltac pickNHeaps := (eapply PNHInductive;[auto | (simpl;reflexivity) | solveSPickElement | pickNHeaps]) || +Ltac pickNHeaps := (eapply PNHInductive;[stripFields | (simpl;reflexivity) | solveSPickElement | pickNHeaps]) || eapply PNHBase. -Fixpoint folded_heap {ev} {eq} {f} {t} {ac} (v : nat) (heaps : list (nat * (@absState ev eq f t ac))) : option nat := +Fixpoint folded_heap (v : nat) (heaps : list (nat * absState)) : option nat := match heaps with | ((x,TREE(root,v(h),size,fields))::r) => if beq_nat h v then Some x else folded_heap v r | (_::r) => folded_heap v r | _ => None end. -Fixpoint noFold {ev} {eq} {f} {t} {ac} (e : @absExp ev eq f) (heaps : list (nat * (@absState ev eq f t ac))) : bool := +Fixpoint noFold (e : absExp) (heaps : list (nat * absState)) : bool := match e with | AbsConstVal v => true | AbsVar vv => true @@ -98,43 +101,57 @@ Fixpoint noFold {ev} {eq} {f} {t} {ac} (e : @absExp ev eq f) (heaps : list (nat end) l end. -Fixpoint foldExp {ev} {eq} {f} {t} {ac} (e : @absExp ev eq f) (heaps : list (nat * (@absState ev eq f t ac))) : @absExp ev eq f := +Fixpoint foldExp (e : absExp) (n : nat) (heaps : list (nat * absState)) : absExp := match e with | AbsConstVal v => (AbsConstVal v) | AbsVar vv => (AbsVar vv) - | AbsQVar v => match folded_heap v heaps with None => (AbsQVar (S v)) | Some x => nth(v(0),#(x+1)) end + | AbsQVar v => match folded_heap v heaps with None => (AbsQVar v) | Some x => nth(v(n),#(x+1)) end | AbsFun i l => AbsFun i ((fix go l := match l with | nil => nil - | (a::b) => (foldExp a heaps)::(go b) + | (a::b) => (foldExp a n heaps)::(go b) end) l) end. -Fixpoint foldState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (heaps : list (nat * (@absState ev eq f t ac))) : @absState ev eq f t ac := +Fixpoint addHeaps (heaps : list (nat * absState)) := + map (fun x => (fst x,addStateVar 0 (snd x))) heaps. + +Fixpoint foldState (s : absState) (n : nat) (heaps : list (nat * absState)) : absState := match s with - | AbsStar s1 s2 => (AbsStar (foldState s1 heaps) (foldState s2 heaps)) - | AbsOrStar s1 s2 => (AbsOrStar (foldState s1 heaps) (foldState s2 heaps)) - | AbsExistsT s => AbsExistsT (foldState s heaps) - | AbsExists e s => AbsExists (foldExp e heaps) (foldState s heaps) - | AbsAll e s => AbsAll (foldExp e heaps) (foldState s heaps) - | AbsEach e s => AbsEach (foldExp e heaps) (foldState s heaps) + | AbsStar s1 s2 => (AbsStar (foldState s1 n heaps) (foldState s2 n heaps)) + | AbsOrStar s1 s2 => (AbsOrStar (foldState s1 n heaps) (foldState s2 n heaps)) + | AbsExistsT s => AbsExistsT (foldState s (S n) (addHeaps heaps)) + | AbsExists e s => AbsExists (foldExp e n heaps) (foldState s (S n) (addHeaps heaps)) + | AbsAll e s => AbsAll (foldExp e n heaps) (foldState s (S n) (addHeaps heaps)) + | AbsEach e s => AbsEach (foldExp e n heaps) (foldState s (S n) (addHeaps heaps)) | AbsEmpty => AbsEmpty - | AbsLeaf i l => AbsLeaf i (map (fun x => foldExp x heaps) l) - | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (foldExp e1 heaps) (foldExp e2 heaps) (foldExp e3 heaps) - | AbsMagicWand s1 s2 => AbsMagicWand (foldState s1 heaps) (foldState s2 heaps) - | AbsUpdateVar s i e => AbsUpdateVar (foldState s heaps) i (foldExp e heaps) - | AbsUpdState s1 s2 s3 => AbsUpdState (foldState s1 heaps) (foldState s2 heaps) (foldState s3 heaps) + | AbsNone => AbsNone + | AbsAny => AbsAny + | AbsLeaf i l => AbsLeaf i (map (fun x => foldExp x n heaps) l) + | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (foldExp e1 n heaps) (foldExp e2 n heaps) (foldExp e3 n heaps) + | AbsMagicWand s1 s2 => AbsMagicWand (foldState s1 n heaps) (foldState s2 n heaps) + | AbsUpdateVar s i e => AbsUpdateVar (foldState s n heaps) i (foldExp e n heaps) + | AbsUpdateWithLoc s i e => AbsUpdateWithLoc (foldState s n heaps) i (foldExp e n heaps) + | AbsUpdateLoc s l e => AbsUpdateLoc (foldState s n heaps) (foldExp l n heaps) (foldExp e n heaps) + | AbsUpdState s1 s2 s3 => AbsUpdState (foldState s1 n heaps) (foldState s2 n heaps) (foldState s3 n heaps) + | AbsClosure s l => AbsClosure s (map (fun x => foldExp x n heaps) l) end. -Fixpoint build_equations {ev} {eq} {f} {t} {ac} (heap : @absExp ev eq f) (cells : list (@absState ev eq f t ac)) (fields : list nat) : @absState ev eq f t ac := +Fixpoint build_equations (heap : absExp) (cells : list absState) (fields : list nat) : absState := match cells with | nil => AbsEmpty | ((l++++#o |-> val)::r) => if mem_nat o fields then - ([nth(nth(heap,#(o+1)),#0)====(pushAbsVar val)]) ** (build_equations heap r fields) + ([nth(nth(heap,#(o+1)),#0)====val]) ** (build_equations heap r fields) else - ([nth(heap,#(o+1))====(pushAbsVar val)]) ** (build_equations heap r fields) + ([nth(heap,#(o+1))====val]) ** (build_equations heap r fields) | (_::r) => build_equations heap r fields end. +Fixpoint getRootLevel (s : absState) : nat := + match s with + | AbsExistsT s => S (getRootLevel s) + | _ => 0 + end. + (* * This is the main fold function. It picks out the CellFun and RFun components to be folded and replaces * them all with a single RFun component. @@ -144,21 +161,16 @@ Fixpoint build_equations {ev} {eq} {f} {t} {ac} (heap : @absExp ev eq f) (cells * #1 : absState - state to be folded * #2 : absState - output of folded state *) -Inductive foldHeap {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> @absState ev eq f t ac -> Prop := - FoldHeap : forall state state2 hvars size fields e_fields cells root r r' r'', +Inductive foldHeap : absState -> absState -> Prop := + FoldHeap : forall state state2 hvars size fields e_fields cells root r r' r'' rl, strip_fields e_fields fields -> r = getRoot state -> pickNCells r r' size root cells -> pickNHeaps r' r'' fields size fields cells hvars -> - state2 = AbsExistsT (replaceRoot state ((TREE(root,v(0),#size,e_fields) ** (build_equations (v(0)) cells fields) ** (foldState r'' hvars)))) -> + rl = getRootLevel state -> + state2 = AbsExistsT (replaceRoot state ((TREE(root,v(rl),#size,e_fields) ** (build_equations (v(rl)) cells fields) ** (foldState r'' rl hvars)))) -> foldHeap state state2. -Fixpoint getRootLevel {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : nat := - match s with - | AbsExistsT s => S (getRootLevel s) - | _ => 0 - end. - (* * This is an auxiliary definition that folds up absAll definitions corresponding to the * TREE that has just been folded by foldHeap. @@ -168,16 +180,16 @@ Fixpoint getRootLevel {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : nat * #1 : absState - state to be folded * #2 : absState - output of folded state *) -Inductive foldAll {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> @absState ev eq f t ac -> Prop := +Inductive foldAll : absState -> absState -> Prop := FoldAll : forall state root root' root'' r roott roott' x n np cond cond' cond'' size e_fields fields var y state2, root = getRoot state -> n = getRootLevel state -> spickElement root (AbsAll TreeRecords(nth(v(x),#np)) cond) root' -> spickElement root' (TREE(r, v(x), #size, fields)) roott -> - spickElement roott ([nth(v(x),y)====var]) roott' -> + spickElement roott ([nth(v(x),#y)====var]) roott' -> strip_fields fields e_fields -> - cond' = replaceStateExp (nth(find(nth(v(x),#np),v(n)),y)) (var) cond -> - cond'' = replaceStateExp nth(v(x),#np) v(x) cond -> + cond' = removeStateVar 0 (replaceStateExp (nth(find(nth(v(S x),#np),v(0)),#y)) (addExpVar 0 var) cond) -> + cond'' = replaceStateExp nth(v(S x),#np) v(S x) cond -> spickElement root' cond' root'' -> state2 = replaceRoot state (AbsStar (AbsAll TreeRecords(v(x)) cond'') root'') -> foldAll state state2. @@ -187,10 +199,11 @@ Inductive foldAll {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> @absState e *) Ltac foldHeap R F S := eapply FoldHeap with (root := R) (fields := F) (size := S);[ - auto | + stripFields | (simpl; reflexivity) | pickNCells | pickNHeaps | + (simpl; reflexivity) | (simpl; reflexivity)]. Ltac foldAll x := @@ -199,17 +212,61 @@ Ltac foldAll x := (simpl; reflexivity) | solveSPickElement | solveSPickElement | - (instantiate (3 := #x);solveSPickElement) | - auto | + (instantiate (3 := x);solveSPickElement) | + stripFields | (simpl; reflexivity) | (simpl; reflexivity) | solveSPickElement | (simpl; reflexivity)]. -Theorem foldSum {ev} {eq} {f} {t} {ac} : forall v e ttt t1 t2 b s e', - @realizeState ev eq f t ac (SUM(range(#0,v),e,t1)) b s -> - @realizeState ev eq f t ac (SUM(range(v++++#1,ttt),e,t2)) b s -> +Theorem foldSum : forall v e ttt t1 t2 b s e', + realizeState (SUM(range(#0,v),e,t1)) b s -> + realizeState (SUM(range(v++++#1,ttt),e,t2)) b s -> e' = replaceExpVar (length b) v e -> - @realizeState ev eq f t ac (SUM(range(#0,ttt),e,t1++++t2++++e')) b s. -Proof. admit. Qed. + realizeState (SUM(range(#0,ttt),e,t1++++t2++++e')) b s. +Proof. admit. Admitted. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/ImpHeap.v b/PEDANTIC/ImpHeap.v index a0ef5dd..db939ac 100644 --- a/PEDANTIC/ImpHeap.v +++ b/PEDANTIC/ImpHeap.v @@ -46,9 +46,9 @@ Definition state := prod env heap. Definition empty_state : state := (empty_env,empty_heap). -Definition env_p := fst. +Definition env_p (s : state) := fst s. -Definition heap_p := snd. +Definition heap_p (s : state) := snd s. (* Basic operations on States *) @@ -449,3 +449,5 @@ Inductive ceval : functions -> state -> com -> state -> result -> Prop := + + diff --git a/PEDANTIC/MagicWandExistsHelper.v b/PEDANTIC/MagicWandExistsHelper.v new file mode 100644 index 0000000..9999a2d --- /dev/null +++ b/PEDANTIC/MagicWandExistsHelper.v @@ -0,0 +1,446 @@ +(********************************************************************************** + * The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic + * Traversal of Instruction Code) verification framework + * + * Developed by Kenneth Roe + * For more information, check out www.cs.jhu.edu/~roe + * + * MagicWandExistsHelper.v + * + **********************************************************************************) + +Require Export SfLib. +Require Export SfLibExtras. +Require Export ImpHeap. +Require Export AbsState. +Require Export AbsExecute. +Require Export AbsStateInstance. +Require Export Simplify. +Require Export Eqdep. +Require Export StateImplication. +Require Export Classical. +Require Export Unfold. +Require Export Fold. +Require Export merge. +Require Export ProgramTactics. + +Fixpoint localizeExists (s : absState) (n : nat) := + match s with + | AbsStar s1 s2 => AbsStar (localizeExists s1 n) (localizeExists s2 n) + | AbsOrStar s1 s2 => AbsOrStar (localizeExists s1 n) (localizeExists s2 n) + | AbsMagicWand s1 s2 => AbsMagicWand (localizeExists s1 n) (localizeExists s2 n) + | AbsUpdateVar s vv vall => AbsUpdateVar (localizeExists s n) vv vall + | AbsUpdateWithLoc s vv vall => AbsUpdateWithLoc (localizeExists s n) vv vall + | AbsUpdateLoc s vv vall => AbsUpdateLoc (localizeExists s n) vv vall + | AbsUpdState s1 s2 s3 => AbsUpdState (localizeExists s1 n) (localizeExists s2 n) (localizeExists s3 n) + | AbsAll e s => AbsAll e (localizeExists s (S n)) + | AbsEach e s => AbsEach e (localizeExists s (S n)) + + | AbsExistsT (AbsStar s1 s2) => if hasVnState s1 0 then + if hasVnState s2 0 then + AbsExistsT (AbsStar (localizeExists s1 (S n)) (localizeExists s2 (S n) )) + else + (AbsStar (AbsExistsT (localizeExists s1 (S n))) (removeStateVar 0 s2)) + else + (AbsStar (removeStateVar 0 s1) (AbsExistsT (localizeExists s2 (S n)))) + | AbsExists e (AbsStar s1 s2) => if hasVnState s1 0 then + if hasVnState s2 0 then + AbsExists e (AbsStar (localizeExists s1 (S n)) (localizeExists s2 (S n))) + else + (AbsStar (AbsExists e (localizeExists s1 (S n))) (removeStateVar 0 s2)) + else + (AbsStar (removeStateVar 0 s1) (AbsExists e (localizeExists s2 (S n)))) + | AbsExistsT s => AbsExistsT (localizeExists s (S n)) + | AbsExists e s => AbsExists e (localizeExists s (S n)) + | x => x + end. + +Theorem localizeExistsThm1 : forall bindings s state1 state2, + state1 = localizeExists state2 0 -> + (realizeState state1 bindings s -> realizeState state2 bindings s). +Proof. + admit. +Admitted. + +Theorem localizeExistsThm2 : forall bindings s state1 state2, + state1 =localizeExists state2 0 -> + (realizeState state2 bindings s -> realizeState state1 bindings s). +Proof. + admit. +Admitted. + +Theorem localizeExistsLeft : forall right res state1 state2, + state1 = localizeExists state2 0 -> + (mergeStates state1 right res -> mergeStates state2 right res). +Proof. + admit. +Admitted. + +Fixpoint hasVarExpList (e : absExp) (l : list id) := + match l with + | nil => false + | (a::b) => if hasVarExp e a then true else hasVarExpList e b + end. + +Fixpoint findVal vlist v (e : absState) := + match e with + | AbsStar l r => match findVal vlist v l with + | Some x => Some x + | None => findVal vlist v r + end + | AbsUpdateVar s vv r => if hasVarExp v vv then None else findVal (vv::vlist) v s + | AbsUpdateWithLoc s vv r => if hasVarExp v vv then None else findVal (vv::vlist) v s + | ( l |-> vv) => if hasVarExpList vv vlist then None else if beq_absExp l v then Some vv + else None + | _ => None + end. + +Fixpoint clearUpdateWithLoc (s : absState) := + match s with + | AbsUpdateWithLoc ss v e => match clearUpdateWithLoc ss with + | sss => match findVal nil e sss with + | None => AbsUpdateWithLoc sss v e + | Some x => AbsUpdateVar sss v x + end + end + | AbsUpdateVar ss v e => AbsUpdateVar (clearUpdateWithLoc ss) v e + | x => x + end. + +Fixpoint clearMagicWandUpdateWithLoc (s : absState) := + match s with + | AbsExistsT e => AbsExistsT (clearMagicWandUpdateWithLoc e) + | AbsExists e s => AbsExists e (clearMagicWandUpdateWithLoc s) + | AbsUpdateVar s v e => AbsUpdateVar (clearMagicWandUpdateWithLoc s) v e + | AbsUpdateWithLoc s v e => AbsUpdateWithLoc (clearMagicWandUpdateWithLoc s) v e + | AbsMagicWand l r => AbsMagicWand (clearUpdateWithLoc l) r + | x => x + end. + +Theorem clearMagicWandUpdateWithLocThm : forall s s' bindings ss, + s' = clearMagicWandUpdateWithLoc s -> + (realizeState s bindings ss -> realizeState s' bindings ss). +Proof. + admit. +Admitted. + +Fixpoint pair_apply1 {t} {r} (f : r -> t -> t -> option r) (b :r) (l1 : list t) (l2 : list t) : option r := + match l1,l2 with + | nil,nil => Some b + | f1::r1,f2::r2 => match f b f1 f2 with + | Some bb => pair_apply1 f bb r1 r2 + | None => None + end + | _, _ => None + end. + +Definition funFix1 (x : option (list (nat * absExp))) := + match x with + | Some b => Some b + | None => None + end. + +Fixpoint matchBinding (v : nat) (e : absExp) (bindings : list (nat * absExp)) := + match bindings with + | nil => Some ((v,e)::nil) + | ((vv,f)::r) => if beq_nat v vv then + (if beq_absExp e f then Some bindings else None) + else + matchBinding v e r + end. + +Fixpoint is_instance (limit : nat) (bindings: list (nat * absExp)) (e1 : absExp) (e2 : absExp) := + match (e1,e2) with + | (AbsConstVal v1,AbsConstVal v2) => if beq_val v1 v2 then Some bindings else None + | (AbsVar v1,AbsVar v2) => if beq_id v1 v2 then (Some bindings) else None + | (AbsQVar v1,AbsQVar v2) => if ble_nat limit v1 then + (if beq_nat v1 (v2+limit) then Some bindings else None) + else matchBinding v1 (AbsQVar v2) bindings + | (AbsQVar v1,t) => if ble_nat limit v1 then + None + else matchBinding v1 t bindings + | (AbsFun i1 el1,AbsFun i2 el2) => if beq_id i1 i2 then + (fix go b l1 l2 := + match l1,l2 with + | (f1::r1),(f2::r2) => match is_instance limit b f1 f2 with + | Some b => go b r1 r2 + | None => None + end + | nil,nil => Some b + | _,_ => None + end) bindings el1 el2 + else None + | (l,r) => None + end. + +Fixpoint is_instance_state (limit : nat) (bindings: list (nat * absExp)) (p : absState) (e : absState) := + match (p,e) with + | (AbsStar l1 l2,AbsStar r1 r2) => match is_instance_state limit bindings l1 r1 with + | Some b => is_instance_state limit bindings l2 r2 + | None => None + end + | (AbsOrStar l1 l2,AbsOrStar r1 r2) => match is_instance_state limit bindings l1 r1 with + | Some b => is_instance_state limit bindings l2 r2 + | None => None + end + | (AbsEmpty,AbsEmpty) => Some bindings + | (AbsLeaf i1 el1,AbsLeaf i2 el2) => if beq_id i1 i2 then + pair_apply1 (is_instance limit) bindings el1 el2 + else None + | (AbsAccumulate i1 e1a e1b e1c,AbsAccumulate i2 e2a e2b e2c) => + if beq_id i1 i2 then + match is_instance limit bindings e1a e2a with + | Some b2 => match is_instance limit b2 e1b e2b with + | Some b3 => is_instance limit b3 e1c e2c + | None => None + end + | None => None + end + else None + | (_,_) => None + end. + +Fixpoint matchExistential (v : nat) (p : absState) (e: absState) := + match p with + | AbsExistsT s => matchExistential (v+1) s e + | _ => is_instance_state v nil p e + end. + +Fixpoint removeSubterm (p : absState) (e: absState) := + match e with + | AbsStar l r => match removeSubterm p l with + | Some ll => Some (AbsStar ll r) + | None => match removeSubterm p r with + | Some rr => Some (AbsStar l rr) + | None => None + end + end + | AbsExistsT e => match removeSubterm (addStateVar 0 p) e with + | Some l => Some (AbsExistsT l) + | None => None + end + | AbsExists ee e => match removeSubterm (addStateVar 0 p) e with + | Some l => Some (AbsExists ee l) + | None => None + end + | AbsUpdateVar s v e => if hasVarState p v then None else + match removeSubterm p s with + | Some x => Some (AbsUpdateVar x v e) + | None => None + end + | AbsUpdateWithLoc s v e => if hasVarState p v then None else + match removeSubterm p s with + | Some x => Some (AbsUpdateWithLoc x v e) + | None => None + end + | _ => match matchExistential 0 p e with + | Some x => Some AbsEmpty + | None => None + end + end. + +Fixpoint removeSubterms (p : absState) (e : absState) := + match p with + | AbsStar l r => match removeSubterms l e with + | Some x => removeSubterms r x + | None => None + end + | x => removeSubterm x e + end. + +Fixpoint removeMagicWand (s : absState) := + match s with + | AbsExistsT e => match removeMagicWand e with + | Some x => Some (AbsExistsT x) + | None => None + end + | AbsExists e s => match removeMagicWand s with + | Some x => Some (AbsExists e x) + | None => None + end + | AbsStar l r => match removeMagicWand l with + | Some x => Some (AbsStar x r) + | None => match removeMagicWand r with + | Some x => Some (AbsStar l x) + | None => None + end + end + | AbsUpdateVar s v e => match removeMagicWand s with + | Some x => Some (AbsUpdateVar x v e) + | None => None + end + | AbsUpdateWithLoc s v e => match removeMagicWand s with + | Some x => Some (AbsUpdateWithLoc x v e) + | None => None + end + | AbsUpdateLoc s v e => match removeMagicWand s with + | Some x => Some (AbsUpdateLoc x v e) + | None => None + end + | AbsMagicWand l r => removeSubterms r l + | x => None + end. + +Theorem removeMagicWandThm : forall s s' bindings ss, + Some s' = removeMagicWand s -> + (realizeState s bindings ss -> realizeState s' bindings ss). +Proof. + admit. +Admitted. + +Theorem removeMagicWandLeft : forall s s' r m, + Some s' = removeMagicWand s -> + (mergeStates s' r m -> mergeStates s r m). +Proof. + admit. +Admitted. + +Theorem removeMagicWandRight : forall s s' l m, + Some s' = removeMagicWand s -> + (mergeStates l s' m -> mergeStates l s m). +Proof. + admit. +Admitted. + +Fixpoint clearSubterm (p : absState) (e: absState) := + match e with + | AbsStar l r => match clearSubterm p l with + | Some b => Some b + | None => clearSubterm p r + end + | AbsUpdateWithLoc s v e => if hasVarState p v then None else clearSubterm p s + | AbsUpdateVar s v e => if hasVarState p v then None else clearSubterm p s + | _ => matchExistential 0 p e + end. + +Fixpoint clearAllSubterms (p : absState) (e: absState) := + match p with + | AbsStar l r => match clearAllSubterms l e with + | Some x => clearAllSubterms r e + | None => None + end + | _ => clearSubterm p e + end. + +Inductive propagateInExists : nat -> absState -> absState -> Prop := + | propagateInExistsId: forall x y n, x=y -> propagateInExists n x y + | propagateInExistsSimp: forall x y z n, + y = localizeExists x n -> + propagateInExists n y z -> + propagateInExists n x z. + + +Fixpoint subn n (s : absState) := + match n with + | 0 => s + | S n' => subn n' (removeStateVar 0 s) + end. + +Theorem magicWandStateExists : forall core st state sub q sub' sub'' n, + getRoot state = AbsMagicWand core sub -> + (exists s, realizeState st nil s) -> + getRoot st = core -> + getRootLevel st = n -> + sub' = subn n sub -> + propagateInExists 0 sub' sub'' -> + clearAllSubterms sub'' core=Some q -> + (exists s, realizeState state nil s). +Proof. + admit. +Admitted. + +Theorem simplifyExists : forall st st', + st' = simplifyState nil st -> + (exists s, realizeState st' nil s) -> + (exists s, realizeState st nil s). +Proof. + admit. +Admitted. + +Theorem existsWithLoc : forall st a b, + (exists s, realizeState st nil s) -> + (exists s, realizeState (AbsUpdateWithLoc st a b) nil s). +Proof. + admit. +Admitted. + +Theorem existsVar : forall st a b, + (exists s, realizeState st nil s) -> + (exists s, realizeState (AbsUpdateVar st a b) nil s). +Proof. + admit. +Admitted. + + +Theorem localizeExistsRightp + : forall P1 P2 P, + mergeStates P1 (localizeExists P2 0) P -> mergeStates P1 P2 P. +Proof. + admit. +Admitted. + +Theorem localizeExistsLeftp + : forall P1 P2 P, + mergeStates (localizeExists P1 0) P2 P -> mergeStates P1 P2 P. +Proof. + admit. +Admitted. + +Theorem existsRealizeState : + forall st st' b s, + (realizeState st b s -> realizeState st' b s) -> + (exists s, realizeState st b s) -> + (exists s, realizeState st' b s). +Proof. + admit. +Admitted. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/PickElement.v b/PEDANTIC/PickElement.v index f7ca6cb..2240511 100644 --- a/PEDANTIC/PickElement.v +++ b/PEDANTIC/PickElement.v @@ -24,7 +24,6 @@ Require Export ImpHeap. Require Export AbsState. Require Export AbsStateInstance. Require Export Coq.Logic.FunctionalExtensionality. -Opaque unitEval. Fixpoint delete_nat (n : nat) (l : list nat) := match l with @@ -57,15 +56,15 @@ Fixpoint no_second (x : nat) (l : list (nat * nat)) : bool := | _ => true end. -Fixpoint noQVarExp {ev} {eq} {f} (e : @absExp ev eq f) : bool := +Fixpoint noQVarExp (e : absExp) : bool := match e with | AbsConstVal v => true | AbsVar v => true | AbsQVar vv => false - | AbsFun i l => (fix go (l : list (@absExp ev eq f)) := match l with | nil => true | (f::r) => if noQVarExp f then go r else false end) l + | AbsFun i l => (fix go (l : list absExp) := match l with | nil => true | (f::r) => if noQVarExp f then go r else false end) l end. -Fixpoint noQVarState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : bool := +Fixpoint noQVarState (s : absState) : bool := match s with | AbsStar s1 s2 => if noQVarState s1 then noQVarState s2 else false | AbsOrStar s1 s2 => if noQVarState s1 then noQVarState s2 else false @@ -74,35 +73,40 @@ Fixpoint noQVarState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : bool | AbsAll e s => if noQVarExp e then noQVarState s else false | AbsEach e s => if noQVarExp e then noQVarState s else false | AbsEmpty => true - | AbsLeaf i l => (fix go (l : list (@absExp ev eq f)) := match l with | nil => true | (f::r) => if noQVarExp f then go r else false end) l + | AbsAny => true + | AbsNone => true + | AbsLeaf i l => (fix go (l : list absExp) := match l with | nil => true | (f::r) => if noQVarExp f then go r else false end) l | AbsAccumulate id e1 e2 e3 => if noQVarExp e1 then if noQVarExp e2 then noQVarExp e3 else false else false | AbsMagicWand s1 s2 => if noQVarState s1 then noQVarState s2 else false | AbsUpdateVar s i e => if noQVarExp e then noQVarState s else false + | AbsUpdateWithLoc s i e => if noQVarExp e then noQVarState s else false + | AbsUpdateLoc s l e => if noQVarExp l then if noQVarExp e then noQVarState s else false else false | AbsUpdState s1 s2 s3 => if noQVarState s1 then if noQVarState s2 then noQVarState s3 else false else false + | AbsClosure s l => (fix go (l : list absExp) := match l with | nil => true | (f::r) => if noQVarExp f then go r else false end) l end. -Fixpoint mem_absExp {ev} {eq} {f} (e : absExp) (l : list (@absExp ev eq f)) := +Fixpoint mem_absExp (e : absExp) (l : list absExp) := match l with | (f::r) => if beq_absExp e f then true else mem_absExp e r | _ => false end. -Fixpoint common_element {ev} {eq} {f} (l1 : list (@absExp ev eq f)) (l2 : list (@absExp ev eq f)) : option (@absExp ev eq f) := +Fixpoint common_element (l1 : list absExp) (l2 : list absExp) : option absExp := match l1 with | (f::r) => if (mem_absExp f l2) then Some f else common_element r l2 | _ => None end. -Fixpoint equiv_absExp2 {ev} {eq} {f} (e1 : (@absExp ev eq f)) (e2 : (@absExp ev eq f)) (s1 : list (@absExp ev eq f)) (equiv2 : list (list (@absExp ev eq f))) : option (@absExp ev eq f) := +Fixpoint equiv_absExp2 (e1 : absExp) (e2 : absExp) (s1 : list absExp) (equiv2 : list (list absExp)) : option absExp := match equiv2 with | (f::r) => if mem_absExp e2 f then common_element s1 f else equiv_absExp2 e1 e2 s1 r | _ => if mem_absExp e2 s1 then Some e2 else None end. -Fixpoint equiv_absExp {ev} {eq} {f} (e1 : (@absExp ev eq f)) (e2 : (@absExp ev eq f)) (equiv1 : list (list (@absExp ev eq f))) (equiv2 : list (list (@absExp ev eq f))) : option (@absExp ev eq f) := +Fixpoint equiv_absExp (e1 : absExp) (e2 : absExp) (equiv1 : list (list absExp)) (equiv2 : list (list absExp)) : option absExp := match equiv1 with | (f::r) => if mem_absExp e1 f then equiv_absExp2 e1 e2 f equiv2 else equiv_absExp e1 e2 r equiv2 | _ => equiv_absExp2 e1 e2 (e1::nil) equiv2 @@ -131,11 +135,11 @@ Fixpoint ml (n : nat) (pairs : list (nat * nat)) : option nat := Fixpoint strip_pair (n1 : nat) (n2 : nat) (pairs : list (nat * nat)) : list (nat * nat) := match pairs with | nil => nil - | ((a,b)::r) => if beq_nat n1 a then if beq_nat n2 b then strip_pair n1 n2 r - else ((a,b)::(strip_pair n1 n2 r)) else ((a,b)::(strip_pair n1 n2 r)) + | ((S a,S b)::r) => ((a,b)::(strip_pair n1 n2 r)) + | (_::r) => strip_pair n1 n2 r end. -Fixpoint mapExpLeft {ev} {eq} {f} (t1 : nat) (t2 : nat) (pairs : list (nat * nat)) (e : @absExp ev eq f) : option (@absExp ev eq f) := +Fixpoint mapExpLeft (t1 : nat) (t2 : nat) (pairs : list (nat * nat)) (e : absExp) : option absExp := match e with | AbsConstVal v => Some (AbsConstVal v) | AbsVar v => Some (AbsVar v) @@ -146,7 +150,7 @@ Fixpoint mapExpLeft {ev} {eq} {f} (t1 : nat) (t2 : nat) (pairs : list (nat * nat | Some x => Some (AbsQVar x) | None => None end - | AbsFun i l => match (fix go (l : list (@absExp ev eq f)) := + | AbsFun i l => match (fix go (l : list absExp) := match l with | nil => Some nil | (f::r) => match (mapExpLeft t1 t2 pairs f,go r) with @@ -159,7 +163,7 @@ Fixpoint mapExpLeft {ev} {eq} {f} (t1 : nat) (t2 : nat) (pairs : list (nat * nat end end. -Fixpoint mapStateLeft {ev} {eq} {f} {t} {ac} (t1 : nat) (t2 : nat) (pairs : list (nat * nat)) (s : @absState ev eq f t ac) : option (@absState ev eq f t ac) := +Fixpoint mapStateLeft (t1 : nat) (t2 : nat) (pairs : list (nat * nat)) (s : absState) : option absState := match s with | AbsStar s1 s2 => match mapStateLeft t1 t2 pairs s1,mapStateLeft t1 t2 pairs s2 with | Some s1,Some s2 => Some (AbsStar s1 s2) @@ -186,7 +190,7 @@ Fixpoint mapStateLeft {ev} {eq} {f} {t} {ac} (t1 : nat) (t2 : nat) (pairs : list | _,_ => None end | AbsEmpty => Some AbsEmpty - | AbsLeaf i l => match (fix go (l : list (@absExp ev eq f)) := + | AbsLeaf i l => match (fix go (l : list absExp) := match l with | nil => Some nil | (f::r) => match (mapExpLeft t1 t2 pairs f,go r) with @@ -229,15 +233,22 @@ Fixpoint mapStateLeft {ev} {eq} {f} {t} {ac} (t1 : nat) (t2 : nat) (pairs : list * Returned: * list of bound variable pairings. *) -Definition funFix {ev} {eq} {f} (x : option ((list (nat * nat)) * (list (@absExp ev eq f)) * (list (@absExp ev eq f)))) i := +Definition funFix (x : option ((list (nat * nat)) * (list absExp) * (list absExp))) i := match x with - | Some (p,tl1,tl2) => Some (p,@AbsFun ev eq f i tl1,@AbsFun ev eq f i tl2) + | Some (p,tl1,tl2) => Some (p,AbsFun i tl1,AbsFun i tl2) | None => None end. -Fixpoint match_expression {ev} {eq} {f} (equivl : list (list (@absExp ev eq f))) (equivr : list (list (@absExp ev eq f))) (limit1 : nat) (limit2 : nat) (e1 : @absExp ev eq f) (e2 : @absExp ev eq f) (pairs : list (nat * nat)) : option ((list (nat * nat)) * (@absExp ev eq f) * (@absExp ev eq f)) := + +Fixpoint push_pairs (l : list (nat * nat)) := + match l with + | ((a,b)::r) => (((S a),(S b))::(push_pairs r)) + | nil => ((0,0)::nil) + end. + +Fixpoint match_expression (equivl : list (list absExp)) (equivr : list (list absExp)) (limit1 : nat) (limit2 : nat) (e1 : absExp) (e2 : absExp) (pairs : list (nat * nat)) : option ((list (nat * nat)) * absExp * absExp) := match (e1,e2) with - | (AbsConstVal v1,AbsConstVal v2) => if @beq_val ev eq v1 v2 then Some (pairs,AbsConstVal v1,AbsConstVal v2) else None + | (AbsConstVal v1,AbsConstVal v2) => if beq_val v1 v2 then Some (pairs,AbsConstVal v1,AbsConstVal v2) else None | (AbsVar v1,AbsVar v2) => if beq_id v1 v2 then (Some (pairs,AbsVar v1, AbsVar v2)) else match equiv_absExp (AbsVar v1) (AbsVar v2) equivl equivr with | Some t => Some (pairs,t,t) @@ -282,9 +293,9 @@ Fixpoint match_expression {ev} {eq} {f} (equivl : list (list (@absExp ev eq f))) * Returned: * list of bound variable pairings. *) -Definition build_leaf {ev} {eq} {f} {t} {ac} (x : option ((list (nat * nat)) * (list (@absExp ev eq f)) * (list (@absExp ev eq f)))) i := +Definition build_leaf (x : option ((list (nat * nat)) * (list absExp) * (list absExp))) i := match x with - | Some (p,l1,l2) => Some (p,@AbsLeaf ev eq f t ac i l1,@AbsLeaf ev eq f t ac i l2) + | Some (p,l1,l2) => Some (p,AbsLeaf i l1,AbsLeaf i l2) | None => None end. @@ -293,7 +304,7 @@ Definition build_leaf {ev} {eq} {f} {t} {ac} (x : option ((list (nat * nat)) * ( ii (el : option ((list (nat * nat)) * (list (@absExp ev eq f)) * (list (@absExp ev eq f))))*) -Fixpoint match_state {ev} {eq} {f} {t} {ac} (limit1 : nat) (limit2 : nat) (pairs : list (nat * nat)) (equivl : list (list (@absExp ev eq f))) (equivr : list (list (@absExp ev eq f))) (l : @absState ev eq f t ac) (r : @absState ev eq f t ac) : option ((list (nat * nat)) * (@absState ev eq f t ac) * (@absState ev eq f t ac)) := +Fixpoint match_state (limit1 : nat) (limit2 : nat) (pairs : list (nat * nat)) (equivl : list (list absExp)) (equivr : list (list absExp)) (l : absState) (r : absState) : option ((list (nat * nat)) * absState * absState) := match (l,r) with | (AbsStar l1 l2,AbsStar r1 r2) => match match_state limit1 limit2 pairs equivl equivr l1 r1 with | Some (p,tl1,tr1) => match match_state limit1 limit2 p equivl equivr l2 r2 with @@ -311,27 +322,27 @@ Fixpoint match_state {ev} {eq} {f} {t} {ac} (limit1 : nat) (limit2 : nat) (pairs end | (AbsEmpty,AbsEmpty) => Some (pairs,AbsEmpty,AbsEmpty) | (AbsExists e1 s1,AbsExists e2 s2) => match match_expression equivl equivr limit1 limit2 e1 e2 pairs with - | Some (r,re1,re2) => match match_state (limit1+1) (limit2+1) ((limit1,limit2)::r) equivl equivr s1 s2 with + | Some (r,re1,re2) => match match_state (limit1+1) (limit2+1) (push_pairs r) equivl equivr s1 s2 with | Some (p,rs1,rs2) => Some (strip_pair limit1 limit2 p,AbsExists re1 rs1,AbsExists re2 rs2) | None => None end | None => None end | (AbsAll e1 s1,AbsAll e2 s2) => match match_expression equivl equivr limit1 limit2 e1 e2 pairs with - | Some (r,re1,re2) => match match_state (limit1+1) (limit2+1) ((limit1,limit2)::r) equivl equivr s1 s2 with + | Some (r,re1,re2) => match match_state (limit1+1) (limit2+1) (push_pairs r) equivl equivr s1 s2 with | Some (p,rs1,rs2) => Some (strip_pair limit1 limit2 p,AbsAll re1 rs1,AbsAll re2 rs2) | None => None end | None => None end | (AbsEach e1 s1,AbsEach e2 s2) => match match_expression equivl equivr limit1 limit2 e1 e2 pairs with - | Some (r,re1,re2) => match match_state (limit1+1) (limit2+1) ((limit1,limit2)::r) equivl equivr s1 s2 with + | Some (r,re1,re2) => match match_state (limit1+1) (limit2+1) (push_pairs r) equivl equivr s1 s2 with | Some (p,rs1,rs2) => Some (strip_pair limit1 limit2 p,AbsEach re1 rs1,AbsEach re2 rs2) | None => None end | None => None end - | (AbsExistsT s1,AbsExistsT s2) => match match_state (limit1+1) (limit2+1) ((limit1,limit2)::pairs) equivl equivr s1 s2 with + | (AbsExistsT s1,AbsExistsT s2) => match match_state (limit1+1) (limit2+1) (push_pairs pairs) equivl equivr s1 s2 with | Some (p,rs1,rs2) => Some (strip_pair limit1 limit2 p,AbsExistsT rs1,AbsExistsT rs2) | None => None end @@ -377,9 +388,9 @@ Fixpoint match_state {ev} {eq} {f} {t} {ac} (limit1 : nat) (limit2 : nat) (pairs * Returned: * list of bound variable pairings. *) -Fixpoint match_expression_ni {ev} {eq} {f} (equivl : list (list (@absExp ev eq f))) (equivr : list (list (@absExp ev eq f))) (limit1 : nat) (limit2 : nat) (e1 : @absExp ev eq f) (e2 : @absExp ev eq f) (pairs : list (nat * nat)) : option ((list (nat * nat)) * (@absExp ev eq f) * (@absExp ev eq f)) := +Fixpoint match_expression_ni (equivl : list (list absExp)) (equivr : list (list absExp)) (limit1 : nat) (limit2 : nat) (e1 : absExp) (e2 : absExp) (pairs : list (nat * nat)) : option ((list (nat * nat)) * absExp * absExp) := match (e1,e2) with - | (AbsConstVal v1,AbsConstVal v2) => if @beq_val ev eq v1 v2 then Some (pairs,AbsConstVal v1,AbsConstVal v2) else None + | (AbsConstVal v1,AbsConstVal v2) => if beq_val v1 v2 then Some (pairs,AbsConstVal v1,AbsConstVal v2) else None | (AbsVar v1,AbsVar v2) => if beq_id v1 v2 then (Some (pairs,AbsVar v1, AbsVar v2)) else match equiv_absExp (AbsVar v1) (AbsVar v2) equivl equivr with | Some t => Some (pairs,t,t) @@ -420,7 +431,7 @@ Fixpoint match_expression_ni {ev} {eq} {f} (equivl : list (list (@absExp ev eq f * Returned: * list of bound variable pairings. *) -Fixpoint match_state_ni {ev} {eq} {f} {t} {ac} (limit1 : nat) (limit2 : nat) (pairs : list (nat * nat)) (equivl : list (list (@absExp ev eq f))) (equivr : list (list (@absExp ev eq f))) (l : @absState ev eq f t ac) (r : @absState ev eq f t ac) : option ((list (nat * nat)) * (@absState ev eq f t ac) * (@absState ev eq f t ac)) := +Fixpoint match_state_ni (limit1 : nat) (limit2 : nat) (pairs : list (nat * nat)) (equivl : list (list absExp)) (equivr : list (list absExp)) (l : absState) (r : absState) : option ((list (nat * nat)) * absState * absState) := match (l,r) with | (AbsStar l1 l2,AbsStar r1 r2) => match match_state_ni limit1 limit2 pairs equivl equivr l1 r1 with | Some (p,tl1,tr1) => match match_state_ni limit1 limit2 p equivl equivr l2 r2 with @@ -438,27 +449,27 @@ Fixpoint match_state_ni {ev} {eq} {f} {t} {ac} (limit1 : nat) (limit2 : nat) (pa end | (AbsEmpty,AbsEmpty) => Some (pairs,AbsEmpty,AbsEmpty) | (AbsExists e1 s1,AbsExists e2 s2) => match match_expression_ni equivl equivr limit1 limit2 e1 e2 pairs with - | Some (r,re1,re2) => match match_state_ni (limit1+1) (limit2+1) ((limit1,limit2)::r) equivl equivr s1 s2 with + | Some (r,re1,re2) => match match_state_ni (limit1+1) (limit2+1) (push_pairs r) equivl equivr s1 s2 with | Some (p, rs1, rs2) => Some (strip_pair limit1 limit2 p,AbsExists re1 rs1,AbsExists re2 rs2) | None => None end | None => None end | (AbsAll e1 s1,AbsAll e2 s2) => match match_expression_ni equivl equivr limit1 limit2 e1 e2 pairs with - | Some (r,re1,re2) => match match_state_ni (limit1+1) (limit2+1) ((limit1,limit2)::r) equivl equivr s1 s2 with + | Some (r,re1,re2) => match match_state_ni (limit1+1) (limit2+1) (push_pairs r) equivl equivr s1 s2 with | Some (p,rs1,rs2) => Some (strip_pair limit1 limit2 p,AbsAll re1 rs1,AbsAll re2 rs2) | None => None end | None => None end | (AbsEach e1 s1,AbsEach e2 s2) => match match_expression_ni equivl equivr limit1 limit2 e1 e2 pairs with - | Some (r,re1,re2) => match match_state_ni (limit1+1) (limit2+1) ((limit1,limit2)::r) equivl equivr s1 s2 with + | Some (r,re1,re2) => match match_state_ni (limit1+1) (limit2+1) (push_pairs r) equivl equivr s1 s2 with | Some (p,rs1,rs2) => Some (strip_pair limit1 limit2 p,AbsEach re1 rs1,AbsEach re2 rs2) | None => None end | None => None end - | (AbsExistsT s1,AbsExistsT s2) => match match_state_ni (limit1+1) (limit2+1) ((limit1,limit2)::pairs) equivl equivr s1 s2 with + | (AbsExistsT s1,AbsExistsT s2) => match match_state_ni (limit1+1) (limit2+1) (push_pairs pairs) equivl equivr s1 s2 with | Some (p,rs1,rs2) => Some (strip_pair limit1 limit2 p, AbsExistsT rs1, AbsExistsT rs2) | None => None end @@ -490,7 +501,7 @@ Fixpoint match_state_ni {ev} {eq} {f} {t} {ac} (limit1 : nat) (limit2 : nat) (pa * #3 : absState - output of the original state where that component is * replaced with EmptyFun *) -Inductive spickElement {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> @absState ev eq f t ac -> @absState ev eq f t ac -> Prop := +Inductive spickElement : absState -> absState -> absState -> Prop := | PESComposeLeft : forall l r e l', spickElement l e l' -> spickElement (AbsStar l r) e (AbsStar l' r) @@ -514,6 +525,75 @@ Ltac solveSPickElement := (eapply PESEach) | (eapply PESOR)]. +(* + * Pick a component out of a state (not necessarily implied true by its position) + * + * Parameters: + * #1 : absState - input of the state to find the element in + * #2 : absState - output of the component + * #3 : absState - output of the original state where that component is + * replaced with EmptyFun + *) +Inductive fpickElement : absState -> absState -> absState -> Prop := + | PEFComposeLeft : forall l r e l', + fpickElement l e l' -> + fpickElement (AbsStar l r) e (AbsStar l' r) + | PEFComposeRight : forall l r e r', + fpickElement r e r' -> + fpickElement (AbsStar l r) e (AbsStar l r') + | PEFUpdState1 : forall l m r e l', + fpickElement l e l' -> + fpickElement (AbsUpdState l m r) e (AbsUpdState l' m r) + | PEFUpdState2 : forall l m r e m', + fpickElement m e m' -> + fpickElement (AbsUpdState l m r) e (AbsUpdState l m' r) + | PEFUpdState3 : forall l m r e r', + fpickElement r e r' -> + fpickElement (AbsUpdState l m r) e (AbsUpdState l m r') + | PEFMagicWandLeft : forall l r e l', + fpickElement l e l' -> + fpickElement (AbsMagicWand l r) e (AbsMagicWand l' r) + | PEFMagicWandRight : forall l r e r', + fpickElement r e r' -> + fpickElement (AbsMagicWand l r) e (AbsMagicWand l r') + | PEFOrComposeLeft : forall l r e l', + fpickElement l e l' -> + fpickElement (AbsOrStar l r) e (AbsOrStar l' r) + | PEFOrComposeRight : forall l r e r', + fpickElement r e r' -> + fpickElement (AbsOrStar l r) e (AbsOrStar l r') + (*| PEFUpdateVar : forall i e s v s', + fpickElement s e s' -> + fpickElement (AbsUpdateVar s i v) e (AbsUpdateVar s' i v) + | PEFUpdateLoc : forall i e s v s', + fpickElement s e s' -> + fpickElement (AbsUpdateLoc s i v) e (AbsUpdateLoc s' i v) + | PEFUpdateWithLoc : forall i e s v s', + fpickElement s e s' -> + fpickElement (AbsUpdateWithLoc s i v) e (AbsUpdateWithLoc s' i v)*) + | PEFAll : forall e p, + fpickElement (AbsAll e p) (AbsAll e p) AbsEmpty + | PEFEach : forall e p, + fpickElement (AbsEach e p) (AbsEach e p) AbsEmpty + | PEFR : forall i el, + fpickElement (AbsLeaf i el) (AbsLeaf i el) AbsEmpty. + +Ltac solveFPickElement := + solve [(eapply PEFComposeLeft;solveFPickElement) | + (eapply PEFComposeRight;solveFPickElement) | + (eapply PEFMagicWandLeft;solveFPickElement) | + (eapply PEFMagicWandRight;solveFPickElement) | + (eapply PEFOrComposeLeft;solveFPickElement) | + (eapply PEFOrComposeRight;solveFPickElement) | + (eapply PEFUpdState1;solveFPickElement) | + (eapply PEFUpdState2;solveFPickElement) | + (eapply PEFUpdState3;solveFPickElement) | + (*(eapply PEFUpdateVar;solveFPickElement) | + (eapply PEFUpdateLoc;solveFPickElement) | + (eapply PEFUpdateWithLoc;solveFPickElement) |*) + (eapply PEFAll) | + (eapply PEFEach) | + (eapply PEFR)]. (* * Pick a component out of a state * @@ -529,7 +609,7 @@ Ltac solveSPickElement := * #9 : absState - remainder of term (with picked out element removed) * #10 : list (list nat) - returned pairs (with additional pairs from match_state) *) -Inductive pickElement {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> (list (nat * nat)) -> nat -> nat -> (list (list (@absExp ev eq f))) -> (list (list (@absExp ev eq f))) -> @absState ev eq f t ac -> @absState ev eq f t ac -> @absState ev eq f t ac -> (list (nat * nat)) -> Prop := +Inductive pickElement : absState -> (list (nat * nat)) -> nat -> nat -> (list (list absExp)) -> (list (list absExp)) -> absState -> absState -> absState -> (list (nat * nat)) -> Prop := | PEComposeLeft : forall l r e e' l' vars vars' limit1 limit2 eq1 eq2, pickElement l vars limit1 limit2 eq1 eq2 e e' l' vars' -> pickElement (AbsStar l r) vars limit1 limit2 eq1 eq2 e e' (AbsStar l' r) vars' @@ -564,7 +644,7 @@ Ltac solvePickElement := * #9 : absState - remainder of term (with picked out element removed) * #10 : list (list nat) - returned pairs (with additional pairs from match_state) *) -Inductive pickElementNi {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> (list (nat * nat)) -> nat -> nat -> (list (list (@absExp ev eq f))) -> (list (list (@absExp ev eq f))) -> @absState ev eq f t ac -> @absState ev eq f t ac -> @absState ev eq f t ac -> (list (nat * nat)) -> Prop := +Inductive pickElementNi : absState -> (list (nat * nat)) -> nat -> nat -> (list (list absExp)) -> (list (list absExp)) -> absState -> absState -> absState -> (list (nat * nat)) -> Prop := | PEComposeLeftNi : forall l r e e' l' vars vars' limit1 limit2 eq1 eq2, pickElementNi l vars limit1 limit2 eq1 eq2 e e' l' vars' -> pickElementNi (AbsStar l r) vars limit1 limit2 eq1 eq2 e e' (AbsStar l' r) vars' @@ -592,7 +672,7 @@ Inductive pickElementNi {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> (list vars''' = strip_pair limit1 limit2 vars'' -> pickElementNi (AbsEach tt' s') vars limit1 limit2 eq1 eq2 (AbsEach tt s) (AbsEach ttl' sl') AbsEmpty vars''' | PERNi : forall r r' i h h' vars vars' vars'' limit1 limit2 eq1 eq2 rl rl' hl hl' eqq1 eqq2, - match (@AbsLeaf ev eq f t ac i (r::h)) with + match (AbsLeaf i (r::h)) with | [a====b] => (nil,nil) | _ => (limit1,limit2) end = (eqq1,eqq2) -> @@ -629,16 +709,16 @@ Ltac solvePickElementNi := * #12 : absState - remainder of second term (with picked out element removed) * #13 : list (list nat) - returned pairs (with additional pairs from match_state) *) -Inductive pick2Rs {ev} {eq} {f} {t} {ac}: @absState ev eq f t ac -> - @absState ev eq f t ac -> +Inductive pick2Rs : absState -> + absState -> list (nat * nat) -> nat -> nat -> - list (list (@absExp ev eq f)) -> - list (list (@absExp ev eq f)) -> + list (list absExp) -> + list (list absExp) -> id -> - list (@absExp ev eq f) -> - list (@absExp ev eq f) -> - @absState ev eq f t ac -> - @absState ev eq f t ac -> + list absExp -> + list absExp -> + absState -> + absState -> list (nat * nat) -> Prop := | P2RComposeFirstLeft : forall a r b c d e ff g h i j k l m, pick2Rs a b c d e ff g h i j k l m -> @@ -675,15 +755,15 @@ Ltac solvePick2Rs := * #11 : absState - remainder of second term (with picked out element removed) * #12 : list (list nat) - returned pairs (with additional pairs from match_state) *) -Inductive pick2RsNi {ev} {eq} {f} {t} {ac}: @absState ev eq f t ac -> - @absState ev eq f t ac -> +Inductive pick2RsNi : absState -> + absState -> list (nat * nat) -> nat -> nat -> - list (list (@absExp ev eq f)) -> - list (list (@absExp ev eq f)) -> - @absState ev eq f t ac -> - @absState ev eq f t ac -> - @absState ev eq f t ac -> - @absState ev eq f t ac -> + list (list absExp) -> + list (list absExp) -> + absState -> + absState -> + absState -> + absState -> list (nat * nat) -> Prop := | P2RComposeFirstLeftNi : forall a r b c d e g h i j k l m, pick2RsNi a b c d e g h i j k l m -> @@ -712,13 +792,13 @@ Ltac solvePick2RsNi := (eapply P2RPickNiExists;solvePickElementNi) || (eapply P2RPickNiEach;solvePickElementNi) ]. -Fixpoint pickElementNiF {ev} {eq} {f} {t} {ac} - (x : @absState ev eq f t ac) (r : @absState ev eq f t ac) +Fixpoint pickElementNiF + (x : absState) (r : absState) (mapping : list (nat * nat)) (limit1 : nat) (limit2 : nat) - (equal_l : list (list (@absExp ev eq f))) (equal_r : list (list (@absExp ev eq f))) : - option ((@absState ev eq f t ac) * (@absState ev eq f t ac) * - (@absState ev eq f t ac) * - (@absState ev eq f t ac) * (list (nat * nat))) := + (equal_l : list (list absExp)) (equal_r : list (list absExp)) : + option (absState * absState * + absState * + absState * (list (nat * nat))) := match r with | (a ** b) => match pickElementNiF x a mapping limit1 limit2 equal_l equal_r with @@ -755,12 +835,64 @@ Fixpoint pickElementNiF {ev} {eq} {f} {t} {ac} end end. -Fixpoint pick2RsNiF {ev} {eq} {f} {t} {ac} - (l : @absState ev eq f t ac) (r : @absState ev eq f t ac) +Fixpoint pickUpdateWithLocNiF + (x : absState) (r : absState) + (mapping : list (nat * nat)) (limit1 : nat) (limit2 : nat) + (equal_l : list (list absExp)) (equal_r : list (list absExp)) : + option (absState * absState * + absState * + absState * (list (nat * nat))) := + match r with + | (a ** b) => + match pickUpdateWithLocNiF x a mapping limit1 limit2 equal_l equal_r with + | Some (s1,s2,t1,t2,p) => Some (s1,s2**b,t1,t2,p) + | None => + match pickUpdateWithLocNiF x b mapping limit1 limit2 equal_l equal_r with + | Some (s1,s2,t1,t2,p) => Some (s1,a**s2,t1,t2,p) + | None => None + end + end + | AbsEmpty => None + | (AbsUpdateWithLoc s2 i2 f2) => + match x with + | (AbsUpdateWithLoc s1 i1 f1) => + if beq_id i1 i2 then + match match_expression_ni equal_l equal_r limit1 limit2 f1 f2 mapping with + | None => None + | Some (pairs,ff1,ff2) => + Some (AbsEmpty,AbsEmpty,AbsUpdateWithLoc s1 i1 f1,AbsUpdateWithLoc s2 i2 f2,pairs) + end + else None + | _ => None + end + | y => None + end. + +Fixpoint pick2UpdateWithLocsNiF + (l : absState) (r : absState) + (mapping : list (nat * nat)) (limit1 : nat) (limit2 : nat) + (equal_l : list (list absExp)) (equal_r : list (list absExp)) : + option (absState * absState * absState * + absState * (list (nat * nat))) := + match l with + | (a ** b) => + match pick2UpdateWithLocsNiF a r mapping limit1 limit2 equal_l equal_r with + | Some (s1,s2,t1,t2,p) => Some (s1**b,s2,t1,t2,p) + | None => match pick2UpdateWithLocsNiF b r mapping limit1 limit2 equal_l equal_r with + | Some (s1,s2,t1,t2,p) => Some (a**s1,s2,t1,t2,p) + | None => None + end + end + | AbsEmpty => None + | x => pickUpdateWithLocNiF x r mapping limit1 limit2 equal_l equal_r + end. + +Fixpoint pick2RsNiF + (l : absState) (r : absState) (mapping : list (nat * nat)) (limit1 : nat) (limit2 : nat) - (equal_l : list (list (@absExp ev eq f))) (equal_r : list (list (@absExp ev eq f))) : - option ((@absState ev eq f t ac) * (@absState ev eq f t ac) * (@absState ev eq f t ac) * - (@absState ev eq f t ac) * (list (nat * nat))) := + (equal_l : list (list absExp)) (equal_r : list (list absExp)) : + option (absState * absState * absState * + absState * (list (nat * nat))) := match l with | (a ** b) => match pick2RsNiF a r mapping limit1 limit2 equal_l equal_r with @@ -777,7 +909,7 @@ Fixpoint pick2RsNiF {ev} {eq} {f} {t} {ac} (* * Test whether an absState has only predicates left--nothing allocating heap space *) -Inductive allPredicates {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> Prop := +Inductive allPredicates : absState -> Prop := | APCompose : forall a b, allPredicates a -> allPredicates b -> @@ -787,6 +919,7 @@ Inductive allPredicates {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> Prop allPredicates b -> allPredicates (a *\/* b) | APPredicate : forall p, allPredicates ([p]) + | APPath : forall a b c d e, allPredicates (Path(a,b,c,d,e)) | APEmpty : allPredicates AbsEmpty | APAccumulate : forall i a b c, allPredicates (AbsAccumulate i a b c) | APAll : forall ttt p, @@ -803,9 +936,9 @@ Inductive allPredicates {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> Prop allPredicates (AbsEach ttt p). -Ltac solveAllPredicates := repeat (eapply APCompose || eapply APOrCompose || eapply APEmpty || eapply APAll || eapply APExists || eapply APExistsT || eapply APAccumulate ||eapply APPredicate || eapply APEach). +Ltac solveAllPredicates := repeat (eapply APCompose || eapply APOrCompose || eapply APEmpty || eapply APAll || eapply APExists || eapply APPath || eapply APExistsT || eapply APAccumulate ||eapply APPredicate || eapply APEach). -Fixpoint remove_top_existentials {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : ((@absState ev eq f t ac) * nat) := +Fixpoint remove_top_existentials (s : absState) : (absState * nat) := match s with | AbsExists l s' => match remove_top_existentials s' with | (s,ln) => (s,(S ln)) @@ -816,12 +949,30 @@ Fixpoint remove_top_existentials {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t | _ => (s,0) end. -Fixpoint restore_top_existentials {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (n : nat) : @absState ev eq f t ac := +Fixpoint restore_top_existentials (s : absState) (n : nat) : absState := match n with | 0 => s | S n1 => AbsExistsT (restore_top_existentials s n1) end. + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/ProgramTactics.v b/PEDANTIC/ProgramTactics.v index 6329520..2f0ed33 100644 --- a/PEDANTIC/ProgramTactics.v +++ b/PEDANTIC/ProgramTactics.v @@ -124,7 +124,10 @@ Ltac pcrunchStep := match goal with | [ H: ceval _ _ (CSkip) _ _ |- _] => (inversion H; subst; clear H) | [ |- _ ] => progress crunchStep | [ |- _ ] => progress auto - + | [ |- mergeReturnStates AbsNone _ _ _ _ _ ] => eapply mergeReturnStatesTrivial1 + | [ |- mergeReturnStates _ AbsNone _ _ _ _ ] => eapply mergeReturnStatesTrivial2 + | [ |- mergeStates AbsNone _ _ ] => eapply mergeStatesTrivial1 + | [ |- mergeStates _ AbsNone _ ] => eapply mergeStatesTrivial2 | [ H: NatValue _ = NoValue |- _ ] => inversion H | [ H: ListValue _ = NoValue |- _ ] => inversion H | [ H: OtherValue _ = NoValue |- _ ] => inversion H @@ -156,12 +159,57 @@ Ltac pcrunchStep := match goal with | [ H: OtherValue _ = OtherValue _ |- _ ] => (inversion H;subst;clear H) | [ |- validExpression _ _ ] => unfold validExpression - | [ |- {{_}}_;_{{_,_}} ] => eapply compose - | [ |- {{_}}_ ::= _{{_,_}} ] => eapply basicAssign - | [ |- {{_}} (CIf _ _ _) {{_,_}} ] => eapply if_statement - | [ |- {{_}} (CLoad _ _) {{_,_}} ] => eapply load;solve [(simpl;reflexivity)] - | [ |- {{_}} (DELETE _,_) {{_,_}} ] => eapply @delete_thm_basic - | [ |- {{_}} (SKIP) {{_,_}} ] => eapply skip_thm + | [ |- {{_}}_;_{{ _ return _ with _ }} ] => eapply compose + | [ |- {{_}}_ ::= _{{ _ return _ with _ }} ] => eapply assign + | [ |- {{_}} (CIf _ _ _) {{ _ return _ with _ }} ] => eapply if_statement + | [ |- {{_}} (CLoad _ _) {{ _ return _ with _ }} ] => eapply load;solve [(simpl;reflexivity)] + | [ |- {{_}} (DELETE _,_) {{ _ return _ with _ }} ] => eapply @del_thm + | [ |- {{_}} (CStore _ _) {{ _ return _ with _ }} ] => eapply @store + | [ |- {{_}} (NEW _,_) {{ _ return _ with _ }} ] => eapply @new_thm + | [ |- {{_}} (SKIP) {{ _ return _ with _ }} ] => eapply skip_thm + | [ |- {{_}} (RETURN _) {{ _ return _ with _ }} ] => eapply return_thm end. Ltac pcrunch := repeat pcrunchStep. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/SatSolverAux1.v b/PEDANTIC/SatSolverAux1.v new file mode 100644 index 0000000..cd3a3f8 --- /dev/null +++ b/PEDANTIC/SatSolverAux1.v @@ -0,0 +1,3544 @@ +(********************************************************************************** + * The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic + * Traversal of Instruction Code) verification framework + * + * Developed by Kenneth Roe + * For more information, check out www.cs.jhu.edu/~roe + * + * SatSolverAux1.v + * This file contains the proof of correctness of a tree traversal algorithm using + * the PEDANTIC verification framework. + * + **********************************************************************************) + +Require Import Omega. +Require Export SfLib. +Require Export SfLibExtras. +Require Export ImpHeap. +Require Export AbsState. +Require Export AbsExecute. +Require Export AbsStateInstance. +Require Export Simplify. +Require Export Eqdep. +Require Export StateImplication. +Require Export Classical. +Require Export Unfold. +Require Export Fold. +Require Export merge. +Require Export ProgramTactics. +Require Export SatSolverDefs. +Require Export UpdateHelper. +Require Export ClosureHelper. +Require Export MagicWandExistsHelper. +Require Export StateHypHelper. +Opaque haveVarInvariant. + +Set Printing Depth 200. + +Theorem precond1Core : + (exists st, realizeState + ([!!(backtrack)] ** + AbsClosure (invariant ** ([#0 <<<< v(2)] *\/* [v(5) ==== #0])) + (!!(clauses) + :: !!(assignments_to_do_head) + :: !!(stack) :: !!(assignments) :: !!(watches) :: nil)) nil + st) -> + (exists st, realizeState (AbsMagicWand + ([!!(backtrack)] ** + AbsClosure (invariant ** ([#0 <<<< v(2)] *\/* [v(5) ==== #0])) + (!!(clauses) + :: !!(assignments_to_do_head) + :: !!(stack) :: !!(assignments) :: !!(watches) :: nil)) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (!!(stack) ++++ #3 |-> v(3) ** + !!(stack) ++++ #2 |-> v(2) ** + !!(stack) ++++ #1 |-> v(1) ** !!(stack) |-> v(0))))))) + nil st). +Proof. + (*intros. destruct H. + eapply ex_intro. + eapply breakTopClosureThm1. unfold invariant. unfold invariantCore. + unfold invariantCoreNoTail. compute. reflexivity. + eapply breakTopClosureThm2 in H. Focus 2. unfold invariant. unfold invariantCore. + unfold invariantCoreNoTail. compute. reflexivity. + eapply breakTopClosureThm1. compute. reflexivity. + simplify. propagateExists. propagateExists. propagateExists. propagateExists. + propagateExists. + eapply unfold_rs1. + unfoldHeap (@AbsVar unit eq_unit (@basicEval unit) stack). + eapply breakTopClosureThm2 in H. Focus 2. compute. reflexivity. + simplifyHyp H. propagateExistsHyp H. propagateExistsHyp H. propagateExistsHyp H. + propagateExistsHyp H. propagateExistsHyp H. eapply unfold_rs2 in H. Focus 2. + unfoldHeap (@AbsVar unit eq_unit (@basicEval unit) stack). + simplify. simplifyHyp H. simplify. simplifyHyp H. + + + eapply magicWandStateExists. simpl. reflexivity. eapply ex_intro. + apply H. simpl. reflexivity. simpl. reflexivity. + simpl. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsId. reflexivity. + compute. reflexivity. + + Grab Existential Variables. apply x.*) + admit. +Admitted. + +Theorem preCond1 : forall x0, + realizeState + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar + ([!! (backtrack)] ** + AbsUpdateVar ([# 1] ** loopInvariant) have_var # 0) + backtrack # 0) varx !! (stack) ++++ # stack_var_offset) + valuex !! (stack) ++++ # stack_val_offset) + ssss !! (stack) ++++ # next_offset) nil x0 -> + exists s : state, + realizeState + (AbsMagicWand + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar + ([!! (backtrack)] ** + AbsUpdateVar ([# 1] ** loopInvariant) have_var # 0) + backtrack # 0) varx !! (stack) ++++ # stack_var_offset) + valuex !! (stack) ++++ # stack_val_offset) + ssss !! (stack) ++++ # next_offset) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 3 |-> v( 4) ** + v( 0) ++++ # 2 |-> v( 3) ** + v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** [!! (stack) ==== v( 0)]))))))) + nil s. +Proof. + (*intros. + decomposeUpdates. + simplifyTheHyp H. + decomposeUpdates. + + eapply simplifyExists. compute. reflexivity. + eapply simplifyExists. compute. reflexivity. + eapply simplifyExists. compute. reflexivity. + eapply simplifyExists. compute. reflexivity. + eapply simplifyExists. compute. reflexivity. + + eapply existsWithLoc. + eapply existsWithLoc. + eapply existsWithLoc. + eapply existsVar. + eapply existsVar. + eapply precond1Core. + eapply ex_intro. + apply H. + + +Grab Existential Variables. + apply x4. apply 0. apply x4. apply 0.*) + admit. +Admitted. + +Opaque numericRange. +Opaque rangeSet. +Opaque Rmember. +Opaque In. +Opaque nth. + +Theorem dumb1: forall x, x + 2 = S (S x). +Proof. + admit. +Admitted. + +Theorem dumb2: forall x, x + 2 + 1 = x + 3. +Proof. + admit. +Admitted. + +Theorem dumb3 : forall x n, S x <= n -> x < n. Proof. admit. Admitted. + + +Theorem preCond2: forall (s : state) (n : nat) (b : id -> nat), realizeState + (AbsUpdateVar + (AbsUpdateVar + (AbsMagicWand + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar + ([!! (backtrack)] ** + AbsUpdateVar ([# 1] ** loopInvariant) + have_var # 0) backtrack + # 0) varx !! (stack) ++++ # stack_var_offset) + valuex !! (stack) ++++ # stack_val_offset) + ssss !! (stack) ++++ # next_offset) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 3 |-> v( 4) ** + v( 0) ++++ # 2 |-> v( 3) ** + v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (stack) ==== v( 0)]))))))) + stack !! (ssss)) have_var # 1) nil s -> + NatValue n = + basicEval AbsPlusId + (NatValue (env_p s assignments) :: @NatValue unit (env_p s varx) :: nil) -> heap_p s n <> None. +Proof. + (*intros. eapply breakTopClosureThm2 in H. Focus 2. unfold loopInvariant. unfold invariant. + unfold invariantCore. unfold invariantCoreNoTail. compute. reflexivity. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + + eapply breakTopClosureThm2 in H. Focus 2. compute. reflexivity. + eapply propagateExistsEquiv1 in H. Focus 2. compute. reflexivity. + eapply propagateExistsEquiv1 in H. Focus 2. compute. reflexivity. + eapply propagateExistsEquiv1 in H. Focus 2. compute. reflexivity. + eapply propagateExistsEquiv1 in H. Focus 2. compute. reflexivity. + eapply propagateExistsEquiv1 in H. Focus 2. compute. reflexivity. + + eapply unfold_rs2 in H. Focus 2. + unfoldHeap (@AbsVar unit eq_unit (@basicEval unit) stack). + Transparent nth. + simplifyTheHyp H. + + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + + eapply clearMagicWandUpdateWithLocThm in H. Focus 2. compute. reflexivity. + eapply removeMagicWandThm in H. Focus 2. compute. reflexivity. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + + eapply stateAssertionThm in H. compute in H. + crunch. + + destruct x3. eapply dumb3 in H27. Transparent basicEval. simpl in H0. + inversion H0; subst; clear H0. rewrite <- glue1. + destruct x0. inversion H26. inversion H26; subst; clear H26. + + assert (exists nv, (x14 (((let (x, _) := s in x) assignments)+((let (x, _) := s in x) varx)) = Some nv /\ nth (((let (x, _) := s in x) varx)+1) l NoValue = NatValue nv)). + + eapply heapMap. apply H0. inversion H13; subst; clear H13. apply H27. + + inversion H3; subst; clear H3. + + assert(exists x, heap_p s ((let (x3, _) := s in x3) assignments + (let (x3, _) := s in x3) varx)=Some x). + eapply ex_intro. eapply H2. eapply H4. + + inversion H3; subst; clear H3. + + rewrite H5. intro X. inversion X. + + inversion H26. inversion H26. + + inversion H27. inversion H27. inversion H27. + + clear H. + compute. intros. + eapply stateAssertionThm in H. compute in H. crunch. + + remember ((let (x4, _) := s0 in x4) stack). destruct n0. inversion H15. + + eapply ex_intro. simpl. reflexivity.*) + admit. + +Admitted. + +Opaque basicEval. + + + + + +Transparent haveVarInvariant. + +Theorem mergeTheorem1 : + + mergeStates + (AbsUpdateVar + (AbsUpdateVar + ([!! (ssss) ==== # 0] ** + AbsUpdateWithLoc + ([~~ # var_count <<<< !! (iiii)] ** haveVarInvariant) + ssss !! (assignments) ++++ !! (iiii)) + varx !! (iiii)) have_var # 1) + ([~~ !! (ssss) ==== # 0] ** + AbsUpdateWithLoc ([~~ # var_count <<<< !! (iiii)] ** haveVarInvariant) + ssss !! (assignments) ++++ !! (iiii)) haveVarInvariant. +Proof. + (*eapply mergeReductionUpdateVarLeft. + eapply mergeReductionUpdateVarLeft2. + eapply removeCondLeftLeft. + eapply removeCondRightLeft. + eapply mergeReductionUpdateWithLocLeft. + eapply mergeReductionUpdateWithLocRight. + eapply removeCondLeftLeft. + eapply removeCondRightLeft. + eapply mergeSame. + + unfold haveVarInvariant. unfold invariantCore. unfold haveVarComponent. + unfold invariantCoreNoTail. compute. reflexivity. + + compute. reflexivity. + + unfold haveVarInvariant. unfold invariantCore. unfold haveVarComponent. + unfold invariantCoreNoTail. + compute. reflexivity. + + compute. reflexivity. + + unfold haveVarInvariant. unfold invariantCore. + unfold invariantCoreNoTail. unfold haveVarComponent. intros. + eapply breakTopClosureThm2 in H. Focus 2. compute. reflexivity. + eapply breakTopClosureThm2 in H. Focus 2. compute. reflexivity. + eapply breakTopClosureThm1. compute. reflexivity. + eapply breakTopClosureThm1. compute. reflexivity. + eapply stripUpdateVarHyp in H. Focus 2. compute. reflexivity. + propagateExists. propagateExists. propagateExists. propagateExists. + propagateExists. propagateExists. + propagateExistsHyp H. propagateExistsHyp H. propagateExistsHyp H. + propagateExistsHyp H. propagateExistsHyp H. propagateExistsHyp H. + eapply stateImplication. apply H. compute. reflexivity. compute. reflexivity. + prove_implication. compute. reflexivity. compute. reflexivity. clear H. + + intros. + destruct b0. compute in H. inversion H. destruct b0. compute in H. inversion H. + destruct b0. compute in H. inversion H. destruct b0. compute in H. inversion H. + destruct b0. compute in H. inversion H. destruct b0. compute in H. inversion H. + destruct b0. Focus 2. simpl in H. + inversion H. compute. + eapply stateAssertionThm in H0. simpl in H0. crunch. + eapply realizeStateSimplify. compute. reflexivity. + inversion H19; subst; clear H19. unfold override in H4. compute in H4. + eapply RSOrComposeL. eapply RSR. compute. + inversion H4; subst; clear H4. rewrite H5. Transparent basicEval. simpl. + reflexivity. + eapply BTStatePredicate. intro X. inversion X. compute. reflexivity. + Transparent nth. Opaque basicEval. simpl in H4. simpl in H3. unfold override in H2. + simpl in H2. rewrite H0 in H3. + eapply RSOrComposeR. eapply RSR. Transparent basicEval. Opaque nth. simpl. + Transparent nth. simpl. Opaque nth. Transparent basicEval. simpl in H4. + assert (match v2 with + | NatValue _ => NoValue + | ListValue l => nth (e varx + 1) l NoValue + | NoValue => NoValue + | OtherValue _ => NoValue + end=NatValue 0). + destruct v2. inversion H4. inversion H5. + + + erewrite H3. reflexivity. omega. reflexivity. reflexivity. rewrite H1. reflexivity. + inversion H4. inversion H5. + inversion H4. inversion H5. + rewrite H5. simpl. reflexivity. + eapply BTStatePredicate. intro X. inversion X. + simpl. reflexivity. + + compute. reflexivity. + + compute. reflexivity.*) + admit. +Admitted. + + +Theorem noResult1 : forall x0 st st' f, + ceval f st + (CIf (!ssss === A0) (varx ::= !iiii; have_var ::= A1) (SKIP)) + st' x0 -> x0 = NoResult. +Proof. + (*intros x0 st st' f H. + inversion H; subst; clear H. inversion H8; subst; clear H8. + inversion H6; subst; clear H6. reflexivity. inversion H5; subst; clear H5. + inversion H5; subst; clear H5. inversion H8; subst; clear H8. reflexivity.*) + admit. +Admitted. + +Theorem entailment1 : forall s : state, + realizeState (AbsUpdateVar haveVarInvariant iiii !!(iiii) ++++ #1) nil s -> + realizeState haveVarInvariant nil s. +Proof. + (*intros. + eapply entailmentUnusedUpdated. apply H. + Transparent haveVarInvariant. unfold haveVarInvariant. unfold invariantCore. + unfold invariantCoreNoTail. unfold haveVarComponent. compute. reflexivity.*) + admit. +Admitted. + + +Theorem entailment2 : forall x0 : state, +forall x0 : state, + realizeState + (AbsUpdateVar + (AbsUpdateVar + ([~~ !! (backtrack)] ** + AbsUpdateVar ([# 1] ** loopInvariant) have_var # 0) + valuex # 1) iiii # 0) nil x0 -> + realizeState haveVarInvariant nil x0. +Proof. + (*intros. + eapply stripUpdateVarHyp in H. Focus 2. compute. reflexivity. + eapply stripUpdateVarHyp in H. Focus 2. compute. reflexivity. + eapply stripUpdateVarHyp in H. Focus 2. compute. reflexivity. + propagateExistsHyp H. propagateExistsHyp H. propagateExistsHyp H. + propagateExistsHyp H. propagateExistsHyp H. propagateExistsHyp H. + propagateExistsHyp H. propagateExistsHyp H. propagateExistsHyp H. + eapply breakTopClosureThm2 in H. Focus 2. compute. reflexivity. + eapply breakTopClosureThm2 in H. Focus 2. compute. reflexivity. + Transparent haveVarInvariant. unfold haveVarInvariant. + unfold invariantCore. unfold haveVarComponent. unfold invariantCoreNoTail. + eapply breakTopClosureThm1. compute. reflexivity. + eapply breakTopClosureThm1. compute. reflexivity. + + eapply stateImplication. apply H. compute. reflexivity. compute. reflexivity. + prove_implication. compute. reflexivity. compute. reflexivity. clear H. + + intros. eapply stateAssertionThm in H0. simpl in H0. crunch. + eapply realizeStateSimplify. compute. reflexivity. + + eapply RSOrComposeL. eapply RSR. compute. Transparent basicEval. unfold basicEval. + rewrite H3. simpl. reflexivity. + eapply BTStatePredicate. omega. unfold empty_heap. simpl. reflexivity.*) + admit. +Admitted. + +Opaque basicEval. + +Fixpoint findArray v (e : absState) := + match e with + | AbsStar l r => match findArray v l with + | Some (x,l') => Some (x,AbsStar l' r) + | None => match findArray v r with + | Some (x,r') => Some (x,AbsStar l r') + | None => None + end + end + | AbsUpdateVar s vv r => match findArray v s with + | Some (a,s') => if hasVarState a vv then None else Some (a,AbsUpdateVar s' vv r) + | None => None + end + | AbsUpdateWithLoc s vv r => match findArray v s with + | Some (a,s') => if hasVarState a vv then None else Some (a,AbsUpdateWithLoc s' vv r) + | None => None + end + | (ARRAY(l,#c,m)) => if beq_absExp l v then Some (ARRAY(l,#c,m),AbsEmpty) else None + | _ => None + end. + +Function stripUpdateLoc (s : absState) := + match s with + | AbsUpdateLoc ss (i++++o) v => match findArray i ss with + | Some (ARRAY(a,b,v(c)),ss') => Some ([nth(v(c),o)====v] ** (AbsExistsT ((replaceStateVar (S c) (replacenth(v(S c),(addExpVar 1 o),v(0))) (addStateVar 1 ss') ** ARRAY(addExpVar 1 a,addExpVar 1 b,v(S(c)))))),ss,(o<<< match stripUpdateLoc ss with + | Some (ss,t,p) => Some (AbsUpdateLoc ss (i++++o) v,t,p) + | None => None + end + end + | AbsExistsT x => match stripUpdateLoc x with + | Some (x,t,p) => Some (AbsExistsT x,t,p) + | _ => None + end + | AbsMagicWand l r => match stripUpdateLoc l with + | Some (l,t,p) => Some (AbsMagicWand l r,t,p) + | None => None + end + | AbsStar l r => match stripUpdateLoc r return option (absState * absState * absExp) with + | Some (r,t,p) => Some (AbsStar l r,t,p) + | None => match stripUpdateLoc l with + | Some (l,t,p) => Some (AbsStar l r,t,p) + | None => None + end + end + | x => None + end. + +Theorem removeUpdateLocLeft : forall l l' r m a b, + Some (l',a,b) = stripUpdateLoc l -> + (forall bind s, realizeState a bind s -> exists q, absEval (fst s) bind b = NatValue (S q)) -> + mergeStates l' r m -> + mergeStates l r m. +Proof. + admit. +Admitted. + + + +Theorem mergeTheorem2Index : forall bind s, realizeState + ((([!! (ssss) ==== nth( v( 7), # 0)] ** + [!! (valuex) ==== v( 9)] ** + [!! (varx) ==== v( 8)] ** + ((((((TREE( !! (clauses), v( 0), # 21, # 0 :: nil) ** + TREE( !! (assignments_to_do_head), v( 1), # 4, # 0 :: nil) ** + TREE( nth( v( 7), # 0), v( 7), # 4, # 0 :: nil) ** + ARRAY( !! (assignments), # 4, v( 2)) ** + ARRAY( !! (watches), # 4, v( 3))) ** + ((([!! (varx) <<<< # 4] ** + AbsAll TreeRecords( v( 7)) + ([nth( find( v( 8), v( 0)), # 2) <<<< # 4])) ** + (([!! (valuex) ==== # 1] *\/* [!! (valuex) ==== # 2]) ** + AbsAll TreeRecords( v( 7)) + ([nth( find( v( 8), v( 0)), # 3) ==== # 1] *\/* + [nth( find( v( 8), v( 0)), # 3) ==== # 2])) ** + ([nth( v( 2), !! (varx)) ==== !! (valuex)] ** + AbsAll TreeRecords( v( 7)) + ([nth( v( 3), nth( find( v( 8), v( 0)), # 2)) ==== + nth( find( v( 8), v( 0)), # 3)])) ** + AbsAll TreeRecords( v( 7)) + ([~~ !! (varx) ==== nth( find( v( 8), v( 0)), # 2)]) ** + AbsAll TreeRecords( v( 7)) + (AbsAll TreeRecords( nth( find( v( 8), v( 0)), # 1)) + ([~~ + nth( find( v( 9), v( 1)), # 2) ==== + nth( find( nth( find( v( 9), v( 1)), # 1), v( 0)), + # 2)]))) ** + AbsAll range( # 0, # 4) + ([nth( v( 3), v( 0)) ==== # 0] *\/* + [!! (varx) ==== v( 0)] *\/* + AbsExists TreeRecords( v( 8)) + ([nth( find( v( 9), v( 0)), # 2) ==== v( 1)] ** + [nth( find( v( 9), v( 0)), # 3) ==== + nth( v( 4), v( 1))]))) ** + AbsAll TreeRecords( v( 1)) + ([--( v( 2), v( 0) )---> # 1 ==== # 0] ** + [nth( v( 2), v( 0)) ==== v( 0)] *\/* + [--( v( 2), v( 0) )---> # 1 inTree v( 0)] ** + [--( v( 2), --( v( 2), v( 0) )---> # 1 )---> # 0 ==== + v( 0)]) ** + AbsEach range( # 0, # 4) + (AbsExistsT + (Path( nth( list( v( 7) + :: v( 9) + :: !! (varx) + :: !! (valuex) :: v( 12) :: nil), + v( 4)), v( 0), v( 5), + # 21, # 13 ++++ v( 4) :: nil) ** + AbsAll TreeRecords( v( 5)) + ([--( v( 6), v( 0) )---> (# 17 ++++ v( 3)) ==== # 0] ** + [nth( v( 6), v( 0)) ==== v( 0)] *\/* + [--( v( 6), v( 0) )---> (# 17 ++++ v( 3)) + inTree v( 0)] ** + [--( v( 6), --( v( 6), v( 0) )---> (# 17 ++++ v( 3)) + )---> (# 13 ++++ v( 3)) ==== + v( 0)]) ** + AbsAll TreeRecords( v( 0)) + (AbsExists range( # 0, # 4) + ([--( v( 1), + list( v( 9) + :: v( 11) + :: !! (varx) + :: !! (valuex) :: v( 14) :: nil) + )---> (# 1 ++++ v( 0))] ** + ([nth( v( 4), v( 0)) ==== # 2] *\/* + [nth( v( 4), v( 0)) ==== # 0]) *\/* + [--( v( 1), + list( v( 9) + :: v( 11) + :: !! (varx) + :: !! (valuex) :: v( 14) :: nil) + )---> (# 5 ++++ v( 2))] ** + ([nth( v( 4), v( 0)) ==== # 1] *\/* + [nth( v( 4), v( 0)) ==== # 0]))) ** + AbsAll range( # 0, # 4) + (([--( v( 0), v( 1) )---> (# 9 ++++ v( 0)) ==== # 0] *\/* + [--( v( 0), v( 1) )---> (# 1 ++++ v( 0))]) *\/* + [--( v( 0), v( 1) )---> (# 5 ++++ v( 0))]) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< --( v( 1), v( 5) )---> (# 9 ++++ v( 0))] ** + ([# 0 <<<< --( v( 1), v( 5) )---> (# 17 ++++ v( 0))] *\/* + [nth( v( 0), v( 2)) ==== v( 1)]) *\/* + ([--( v( 1), v( 5) )---> (# 9 ++++ v( 0)) ==== # 0] ** + [--( v( 1), v( 5) )---> (# 17 ++++ v( 0)) ==== # 0]) ** + [~~ nth( v( 4), v( 0)) ==== v( 5)]) ** + SUM( range( # 0, # 4), + # 0 <<<< --( v( 0), v( 4) )---> (# 9 ++++ v( 0)), + # 2) ** + (SUM( range( # 0, # 4), + (--( v( 4), v( 3) )---> (# 1 ++++ v( 0)) \\// + --( v( 4), v( 3) )---> (# 5 ++++ v( 0))) //\\ + nth( v( 3), v( 0)) ==== # 0, + # 1) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< --( v( 1), v( 5) )---> (# 9 ++++ v( 0))] ** + [nth( v( 5), v( 0)) ==== # 0] *\/* + [# 0 <<<< nth( v( 5), v( 0))] *\/* + [--( v( 1), v( 5) )---> (# 1 ++++ v( 0)) ==== # 0] ** + [--( v( 1), v( 5) )---> (# 5 ++++ v( 0)) ==== # 0]) ** + AbsAll range( # 0, # 4) + (AbsAll range( # 0, # 4) + ((((([--( v( 2), v( 6) )---> (# 9 ++++ v( 0))] *\/* + [--( v( 2), v( 6) )---> (# 1 ++++ v( 0)) ==== + # 0] ** + [--( v( 2), v( 6) )---> (# 5 ++++ v( 0)) ==== + # 0]) *\/* + [~~ --( v( 2), v( 6) )---> (# 9 ++++ v( 1))]) *\/* + [nth( v( 5), v( 1)) ==== # 0]) *\/* + [v( 0) ==== v( 1)]) *\/* + AbsExists TreeRecords( v( 4)) + ([nth( find( v( 5), v( 0)), # 2) ==== v( 2)] ** + AbsExists TreeRecords( find( v( 5), v( 0))) + ([nth( find( v( 6), v( 0)), # 2) ==== v( 1)])))) *\/* + AbsExists range( # 0, # 4) + ([--( v( 1), v( 5) )---> (# 1 ++++ v( 0))] ** + [nth( v( 4), v( 0)) ==== # 2] *\/* + [--( v( 1), v( 5) )---> (# 5 ++++ v( 0))] ** + [nth( v( 1), v( 5)) ==== # 1]) ** + AbsAll range( # 0, # 4) + ([# 0 ==== nth( v( 4), v( 0))] *\/* + [--( v( 1), v( 5) )---> (# 9 ++++ v( 0)) ==== # 0] ** + [# 0 <<<< nth( v( 4), v( 0))] *\/* + AbsExists TreeRecords( v( 3)) + ([nth( find( v( 4), v( 0)), # 2) ==== v( 1)]) ** + AbsExists TreeRecords( find( v( 0), v( 0))) + ([# 0 <<<< + --( v( 2), v( 6) + )---> (# 1 ++++ nth( find( v( 4), v( 0)), # 2))] ** + [nth( find( v( 4), v( 0)), # 3) ==== # 2] *\/* + [# 0 <<<< + --( v( 2), v( 6) + )---> (# 5 ++++ nth( find( v( 4), v( 0)), # 2))] ** + [nth( find( v( 4), v( 0)), # 3) ==== # 1])) *\/* + AbsAll range( # 0, # 4) + ([--( v( 1), v( 5) )---> (# 9 ++++ v( 0)) ==== # 0] *\/* + [nth( v( 4), v( 0)) ==== # 0]))))) ** + [!! (assignments_to_do_head) inTree v( 1)] ** + [nth( find( !! (assignments_to_do_head), v( 1)), # 1) ==== # 0]) ** + [# 0 <<<< v( 5)]) ** [v( 6) ==== # 0]) ** + [v( 4)]) ** [!! (backtrack) ==== # 0]) ** + [!! (stack) ==== !! (ssss)]) ** [!! (have_var) ==== # 1]) bind s -> +exists q : nat, absEval + (fst s) bind !! (varx) <<<< # 4 = NatValue (S q). +Proof. + intros bind s H. + admit. +Admitted. + +Theorem mergeImplies : forall l r m, + (exists m', mergeStates l r m' /\ (forall s, realizeState m' nil s -> realizeState m nil s)) -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Theorem mergePredicateTheorem1 : +forall (eee : env) (hhh : heap) (bbb : list Value), + length bbb = 12 -> + realizeState + (([nth( v( 4), !! (varx)) ==== # 0] ** + ((([!! (ssss) ==== nth( v( 8), # 0)] ** + [!! (valuex) ==== v( 10)] ** + [!! (varx) ==== v( 9)] ** + ((((((AbsEmpty ** AbsEmpty ** AbsEmpty ** AbsEmpty) ** + ((([!! (varx) <<<< # 4] ** AbsEmpty) ** + (([!! (valuex) ==== # 1] *\/* [!! (valuex) ==== # 2]) ** + AbsEmpty) ** + ([v( 0) ==== !! (valuex)] ** + AbsAll TreeRecords( v( 8)) + ([nth( replacenth( v( 5), !! (varx), !! (valuex)), + nth( find( v( 9), v( 0)), # 2)) ==== + nth( find( v( 9), v( 0)), # 3)])) ** AbsEmpty) ** + AbsAll range( # 0, # 4) + ([nth( v( 5), v( 0)) ==== # 0] *\/* + [!! (varx) ==== v( 0)] *\/* + AbsExists TreeRecords( v( 9)) + ([nth( find( v( 10), v( 0)), # 2) ==== v( 1)] ** + [nth( find( v( 10), v( 0)), # 3) ==== nth( v( 6), v( 1))]))) ** + AbsEmpty ** + AbsEach range( # 0, # 4) + (AbsExistsT + (Path( nth( list( v( 9) + :: v( 10) + :: !! (varx) + :: !! (valuex) :: v( 13) :: nil), + replacenth( v( 6), !! (varx), !! (valuex))), + v( 0), v( 7), # 21, + # 13 ++++ replacenth( v( 6), !! (varx), !! (valuex)) + :: nil) ** + AbsAll TreeRecords( v( 7)) + ([--( v( 8), v( 0) )---> (# 17 ++++ !! (valuex)) ==== + # 0] ** [nth( v( 8), v( 0)) ==== v( 0)] *\/* + [--( v( 8), v( 0) )---> (# 17 ++++ !! (valuex)) + inTree v( 0)] ** + [--( v( 8), + --( v( 8), v( 0) )---> (# 17 ++++ !! (valuex)) + )---> (# 13 ++++ !! (valuex)) ==== + v( 0)]) ** + AbsAll TreeRecords( v( 0)) + (AbsExists range( # 0, # 4) + ([--( v( 1), + list( v( 11) + :: v( 12) + :: !! (varx) + :: !! (valuex) :: v( 15) :: nil) + )---> (# 1 ++++ v( 0))] ** + ([nth( !! (valuex), v( 0)) ==== # 2] *\/* + [nth( !! (valuex), v( 0)) ==== # 0]) *\/* + [--( v( 1), + list( v( 11) + :: v( 12) + :: !! (varx) + :: !! (valuex) :: v( 15) :: nil) + )---> (# 5 ++++ v( 2))] ** + ([nth( !! (valuex), v( 0)) ==== # 1] *\/* + [nth( !! (valuex), v( 0)) ==== # 0]))) ** + AbsAll range( # 0, # 4) + (([--( v( 0), v( 1) )---> (# 9 ++++ v( 0)) ==== # 0] *\/* + [--( v( 0), v( 1) )---> (# 1 ++++ v( 0))]) *\/* + [--( v( 0), v( 1) )---> (# 5 ++++ v( 0))]) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< + --( v( 1), replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0))] ** + ([# 0 <<<< + --( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 17 ++++ v( 0))] *\/* + [nth( v( 0), v( 2)) ==== v( 1)]) *\/* + ([--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)) ==== + # 0] ** + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 17 ++++ v( 0)) ==== + # 0]) ** + [~~ + nth( v( 5), v( 0)) ==== + replacenth( v( 7), !! (varx), !! (valuex))]) ** + SUM( range( # 0, # 4), + # 0 <<<< + --( v( 0), replacenth( v( 6), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)), # 2) ** + (SUM( range( # 0, # 4), + (--( replacenth( v( 6), !! (varx), !! (valuex)), + v( 4) )---> (# 1 ++++ v( 0)) \\// + --( replacenth( v( 6), !! (varx), !! (valuex)), + v( 4) )---> (# 5 ++++ v( 0))) //\\ + nth( v( 4), v( 0)) ==== # 0, + # 1) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< + --( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0))] ** + [nth( replacenth( v( 7), !! (varx), !! (valuex)), + v( 0)) ==== # 0] *\/* + [# 0 <<<< + nth( replacenth( v( 7), !! (varx), !! (valuex)), + v( 0))] *\/* + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 1 ++++ v( 0)) ==== + # 0] ** + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 5 ++++ v( 0)) ==== + # 0]) ** + AbsAll range( # 0, # 4) + (AbsAll range( # 0, # 4) + ((((([--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0))] *\/* + [--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 1 ++++ v( 0)) ==== + # 0] ** + [--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 5 ++++ v( 0)) ==== + # 0]) *\/* + [~~ + --( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 1))]) *\/* + [nth( v( 6), v( 1)) ==== # 0]) *\/* + [v( 0) ==== v( 1)]) *\/* + AbsExists (AbsConstVal (ListValue nil)) + (AbsExists + TreeRecords( find( !! (valuex), v( 0))) + ([nth( find( !! (valuex), v( 1)), # 2) ==== + v( 3)] ** + [nth( find( !! (valuex), v( 0)), # 2) ==== + v( 1)])))) *\/* + AbsExists range( # 0, # 4) + (([--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 1 ++++ v( 0))] ** + [nth( v( 5), v( 0)) ==== # 2] *\/* + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 5 ++++ v( 0))] ** + [nth( v( 1), + replacenth( v( 7), !! (varx), !! (valuex))) ==== + # 1]) ** + AbsAll range( # 0, # 4) + ([# 0 ==== nth( v( 6), v( 0))] *\/* + [--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)) ==== + # 0] ** [# 0 <<<< nth( v( 6), v( 0))] *\/* + AbsExists (AbsConstVal (ListValue nil)) + ([nth( find( !! (valuex), v( 0)), # 2) ==== + v( 1)] ** + AbsExists TreeRecords( find( v( 1), v( 1))) + ([# 0 <<<< + --( v( 4), + replacenth( v( 10), !! (varx), !! (valuex)) + )---> (# 1 ++++ + nth( find( !! (valuex), v( 0)), # 2))] ** + [nth( find( !! (valuex), v( 0)), # 3) ==== + # 2] *\/* + [# 0 <<<< + --( v( 4), + replacenth( v( 10), !! (varx), !! (valuex)) + )---> (# 5 ++++ + nth( find( !! (valuex), v( 0)), # 2))] ** + [nth( find( !! (valuex), v( 0)), # 3) ==== + # 1])))) *\/* + AbsAll range( # 0, # 4) + ([--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)) ==== + # 0] *\/* [nth( v( 5), v( 0)) ==== # 0]))))) ** + AbsEmpty ** AbsEmpty) ** + ([# 0 <<<< v( 7)] *\/* [v( 6) ==== # 0])) ** + [!! (valuex)]) ** [v( 3) ==== # 0]) ** + [!! (backtrack) ==== # 0]) ** [!! (stack) ==== !! (ssss)]) ** + [!! (have_var) ==== # 1]) ** AbsEmpty) ** + (ARRAY( !! (assignments), # 4, v( 4)) ** + [nth( find( !! (assignments_to_do_head), v( 2)), # 1) ==== # 0] ** + [!! (assignments_to_do_head) inTree v( 2)] ** + AbsAll TreeRecords( v( 2)) + ([--( v( 3), v( 0) )---> # 1 ==== # 0] ** + [nth( v( 3), v( 0)) ==== v( 0)] *\/* + [--( v( 3), v( 0) )---> # 1 inTree v( 0)] ** + [--( v( 3), --( v( 3), v( 0) )---> # 1 )---> # 0 ==== v( 0)]) ** + AbsAll TreeRecords( v( 8)) + (AbsAll TreeRecords( nth( find( v( 9), v( 0)), # 2)) + ([~~ + nth( find( v( 10), v( 1)), # 2) ==== + nth( find( nth( find( v( 10), v( 1)), # 2), v( 0)), # 2)])) ** + AbsAll TreeRecords( v( 8)) + ([nth( find( v( 9), v( 0)), # 3) ==== # 1] *\/* + [nth( find( v( 9), v( 0)), # 3) ==== # 2]) ** + AbsAll TreeRecords( v( 8)) ([nth( find( v( 9), v( 0)), # 2) <<<< # 4]) ** + ARRAY( !! (watches), # 4, v( 5)) ** + TREE( !! (stack), v( 8), # 4, # 0 :: nil) ** + TREE( !! (assignments_to_do_head), v( 2), # 4, # 0 :: nil) ** + TREE( !! (clauses), v( 0), # 21, # 0 :: nil) ** AbsEmpty) ** + build_equivs + ((!! (have_var) :: # 1 :: nil) + :: (!! (varx) :: v( 9) :: nil) + :: (v( 10) :: v( 0) :: !! (valuex) :: nil) + :: (nth( v( 8), # 0) :: !! (stack) :: !! (ssss) :: nil) + :: (nth( v( 4), !! (varx)) + :: nth( find( !! (assignments_to_do_head), v( 2)), # 1) + :: v( 3) :: !! (backtrack) :: # 0 :: nil) :: nil)) + bbb (eee, hhh) -> + realizeState + (AbsAll TreeRecords( v( 8)) + ([nth( v( 5), nth( find( v( 9), v( 0)), # 2)) ==== + nth( find( v( 9), v( 0)), # 3)])) bbb (eee, empty_heap). +Proof. + admit. +Admitted. + +Theorem mergePredicateTheorem2 : +forall (eee : env) (hhh : heap) (bbb : list Value), + length bbb = 12 -> + realizeState + (([nth( v( 4), !! (varx)) ==== # 0] ** + ((([!! (ssss) ==== nth( v( 8), # 0)] ** + [!! (valuex) ==== v( 10)] ** + [!! (varx) ==== v( 9)] ** + ((((((AbsEmpty ** AbsEmpty ** AbsEmpty ** AbsEmpty) ** + ((([!! (varx) <<<< # 4] ** AbsEmpty) ** + (([!! (valuex) ==== # 1] *\/* [!! (valuex) ==== # 2]) ** + AbsEmpty) ** + ([v( 0) ==== !! (valuex)] ** + AbsAll TreeRecords( v( 8)) + ([nth( replacenth( v( 5), !! (varx), !! (valuex)), + nth( find( v( 9), v( 0)), # 2)) ==== + nth( find( v( 9), v( 0)), # 3)])) ** AbsEmpty) ** + AbsAll range( # 0, # 4) + ([nth( v( 5), v( 0)) ==== # 0] *\/* + [!! (varx) ==== v( 0)] *\/* + AbsExists TreeRecords( v( 9)) + ([nth( find( v( 10), v( 0)), # 2) ==== v( 1)] ** + [nth( find( v( 10), v( 0)), # 3) ==== nth( v( 6), v( 1))]))) ** + AbsEmpty ** + AbsEach range( # 0, # 4) + (AbsExistsT + (Path( nth( list( v( 9) + :: v( 10) + :: !! (varx) + :: !! (valuex) :: v( 13) :: nil), + replacenth( v( 6), !! (varx), !! (valuex))), + v( 0), v( 7), # 21, + # 13 ++++ replacenth( v( 6), !! (varx), !! (valuex)) + :: nil) ** + AbsAll TreeRecords( v( 7)) + ([--( v( 8), v( 0) )---> (# 17 ++++ !! (valuex)) ==== + # 0] ** [nth( v( 8), v( 0)) ==== v( 0)] *\/* + [--( v( 8), v( 0) )---> (# 17 ++++ !! (valuex)) + inTree v( 0)] ** + [--( v( 8), + --( v( 8), v( 0) )---> (# 17 ++++ !! (valuex)) + )---> (# 13 ++++ !! (valuex)) ==== + v( 0)]) ** + AbsAll TreeRecords( v( 0)) + (AbsExists range( # 0, # 4) + ([--( v( 1), + list( v( 11) + :: v( 12) + :: !! (varx) + :: !! (valuex) :: v( 15) :: nil) + )---> (# 1 ++++ v( 0))] ** + ([nth( !! (valuex), v( 0)) ==== # 2] *\/* + [nth( !! (valuex), v( 0)) ==== # 0]) *\/* + [--( v( 1), + list( v( 11) + :: v( 12) + :: !! (varx) + :: !! (valuex) :: v( 15) :: nil) + )---> (# 5 ++++ v( 2))] ** + ([nth( !! (valuex), v( 0)) ==== # 1] *\/* + [nth( !! (valuex), v( 0)) ==== # 0]))) ** + AbsAll range( # 0, # 4) + (([--( v( 0), v( 1) )---> (# 9 ++++ v( 0)) ==== # 0] *\/* + [--( v( 0), v( 1) )---> (# 1 ++++ v( 0))]) *\/* + [--( v( 0), v( 1) )---> (# 5 ++++ v( 0))]) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< + --( v( 1), replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0))] ** + ([# 0 <<<< + --( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 17 ++++ v( 0))] *\/* + [nth( v( 0), v( 2)) ==== v( 1)]) *\/* + ([--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)) ==== + # 0] ** + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 17 ++++ v( 0)) ==== + # 0]) ** + [~~ + nth( v( 5), v( 0)) ==== + replacenth( v( 7), !! (varx), !! (valuex))]) ** + SUM( range( # 0, # 4), + # 0 <<<< + --( v( 0), replacenth( v( 6), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)), # 2) ** + (SUM( range( # 0, # 4), + (--( replacenth( v( 6), !! (varx), !! (valuex)), + v( 4) )---> (# 1 ++++ v( 0)) \\// + --( replacenth( v( 6), !! (varx), !! (valuex)), + v( 4) )---> (# 5 ++++ v( 0))) //\\ + nth( v( 4), v( 0)) ==== # 0, + # 1) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< + --( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0))] ** + [nth( replacenth( v( 7), !! (varx), !! (valuex)), + v( 0)) ==== # 0] *\/* + [# 0 <<<< + nth( replacenth( v( 7), !! (varx), !! (valuex)), + v( 0))] *\/* + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 1 ++++ v( 0)) ==== + # 0] ** + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 5 ++++ v( 0)) ==== + # 0]) ** + AbsAll range( # 0, # 4) + (AbsAll range( # 0, # 4) + ((((([--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0))] *\/* + [--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 1 ++++ v( 0)) ==== + # 0] ** + [--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 5 ++++ v( 0)) ==== + # 0]) *\/* + [~~ + --( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 1))]) *\/* + [nth( v( 6), v( 1)) ==== # 0]) *\/* + [v( 0) ==== v( 1)]) *\/* + AbsExists (AbsConstVal (ListValue nil)) + (AbsExists + TreeRecords( find( !! (valuex), v( 0))) + ([nth( find( !! (valuex), v( 1)), # 2) ==== + v( 3)] ** + [nth( find( !! (valuex), v( 0)), # 2) ==== + v( 1)])))) *\/* + AbsExists range( # 0, # 4) + (([--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 1 ++++ v( 0))] ** + [nth( v( 5), v( 0)) ==== # 2] *\/* + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 5 ++++ v( 0))] ** + [nth( v( 1), + replacenth( v( 7), !! (varx), !! (valuex))) ==== + # 1]) ** + AbsAll range( # 0, # 4) + ([# 0 ==== nth( v( 6), v( 0))] *\/* + [--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)) ==== + # 0] ** [# 0 <<<< nth( v( 6), v( 0))] *\/* + AbsExists (AbsConstVal (ListValue nil)) + ([nth( find( !! (valuex), v( 0)), # 2) ==== + v( 1)] ** + AbsExists TreeRecords( find( v( 1), v( 1))) + ([# 0 <<<< + --( v( 4), + replacenth( v( 10), !! (varx), !! (valuex)) + )---> (# 1 ++++ + nth( find( !! (valuex), v( 0)), # 2))] ** + [nth( find( !! (valuex), v( 0)), # 3) ==== + # 2] *\/* + [# 0 <<<< + --( v( 4), + replacenth( v( 10), !! (varx), !! (valuex)) + )---> (# 5 ++++ + nth( find( !! (valuex), v( 0)), # 2))] ** + [nth( find( !! (valuex), v( 0)), # 3) ==== + # 1])))) *\/* + AbsAll range( # 0, # 4) + ([--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)) ==== + # 0] *\/* [nth( v( 5), v( 0)) ==== # 0]))))) ** + AbsEmpty ** AbsEmpty) ** + ([# 0 <<<< v( 7)] *\/* [v( 6) ==== # 0])) ** + [!! (valuex)]) ** [v( 3) ==== # 0]) ** + [!! (backtrack) ==== # 0]) ** [!! (stack) ==== !! (ssss)]) ** + [!! (have_var) ==== # 1]) ** AbsEmpty) ** + (ARRAY( !! (assignments), # 4, v( 4)) ** + [nth( find( !! (assignments_to_do_head), v( 2)), # 1) ==== # 0] ** + [!! (assignments_to_do_head) inTree v( 2)] ** + AbsAll TreeRecords( v( 2)) + ([--( v( 3), v( 0) )---> # 1 ==== # 0] ** + [nth( v( 3), v( 0)) ==== v( 0)] *\/* + [--( v( 3), v( 0) )---> # 1 inTree v( 0)] ** + [--( v( 3), --( v( 3), v( 0) )---> # 1 )---> # 0 ==== v( 0)]) ** + AbsAll TreeRecords( v( 8)) + (AbsAll TreeRecords( nth( find( v( 9), v( 0)), # 2)) + ([~~ + nth( find( v( 10), v( 1)), # 2) ==== + nth( find( nth( find( v( 10), v( 1)), # 2), v( 0)), # 2)])) ** + AbsAll TreeRecords( v( 8)) + ([nth( find( v( 9), v( 0)), # 3) ==== # 1] *\/* + [nth( find( v( 9), v( 0)), # 3) ==== # 2]) ** + AbsAll TreeRecords( v( 8)) ([nth( find( v( 9), v( 0)), # 2) <<<< # 4]) ** + ARRAY( !! (watches), # 4, v( 5)) ** + TREE( !! (stack), v( 8), # 4, # 0 :: nil) ** + TREE( !! (assignments_to_do_head), v( 2), # 4, # 0 :: nil) ** + TREE( !! (clauses), v( 0), # 21, # 0 :: nil) ** AbsEmpty) ** + build_equivs + ((!! (have_var) :: # 1 :: nil) + :: (!! (varx) :: v( 9) :: nil) + :: (v( 10) :: v( 0) :: !! (valuex) :: nil) + :: (nth( v( 8), # 0) :: !! (stack) :: !! (ssss) :: nil) + :: (nth( v( 4), !! (varx)) + :: nth( find( !! (assignments_to_do_head), v( 2)), # 1) + :: v( 3) :: !! (backtrack) :: # 0 :: nil) :: nil)) + bbb (eee, hhh) -> + realizeState + (AbsAll range( # 0, # 4) + ([nth( v( 5), v( 0)) ==== # 0] *\/* + AbsExists TreeRecords( v( 9)) + ([nth( find( v( 10), v( 0)), # 2) ==== v( 1)] ** + [nth( find( v( 10), v( 0)), # 3) ==== nth( v( 6), v( 1))]))) bbb + (eee, empty_heap). +Proof. + admit. +Admitted. + +Transparent nth. + +Theorem mergeFinalImplication1: forall s, +realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( + !! (clauses), + v( 0), + # 21, + # 0 :: nil) ** + TREE( + !! (assignments_to_do_head), + v( 2), + # 4, + # 0 :: nil) ** + TREE( + !! (stack), + v( 8), + # 4, + # 0 :: nil) ** + ARRAY( !! (watches), # 4, v( 5)) ** + AbsAll + TreeRecords( v( 8)) + ([nth( + find( v( 9), v( 0)), + # 2) <<<< + # 4]) ** + AbsAll + TreeRecords( v( 8)) + ([nth( + find( v( 9), v( 0)), + # 3) ==== + # 1] *\/* + [nth( + find( v( 9), v( 0)), + # 3) ==== + # 2]) ** + AbsAll + TreeRecords( v( 8)) + (AbsAll + TreeRecords( + nth( + find( v( 9), v( 0)), + # 2)) + ([ + ~~ + nth( + find( v( 10), v( 1)), + # 2) ==== + nth( + find( + nth( + find( v( 10), v( 1)), + # 2), + v( 0)), + # 2)])) ** + AbsAll + TreeRecords( v( 2)) + ([--( v( 3), v( 0) )---> # 1 ==== + # 0] ** + [nth( v( 3), v( 0)) ==== + v( 0)] *\/* + [--( v( 3), v( 0) )---> # 1 + inTree + v( 0)] ** + [--( + v( 3), + --( v( 3), v( 0) )---> # 1 + )---> + # 0 ==== + v( 0)]) ** + [!! (assignments_to_do_head) + inTree + v( 2)] ** + [nth( + find( + !! (assignments_to_do_head), + v( 2)), + # 1) ==== + # 0] ** + ARRAY( + !! (assignments), + # 4, + v( 4)) ** + AbsAll + TreeRecords( v( 8)) + ([nth( + v( 5), + nth( + find( v( 9), v( 0)), + # 2)) ==== + nth( + find( v( 9), v( 0)), + # 3)]) ** + AbsAll + range( # 0, # 4) + ([nth( v( 5), v( 0)) ==== # 0] *\/* + AbsExists + TreeRecords( v( 9)) + ([ + nth( + find( v( 10), v( 0)), + # 2) ==== + v( 1)] ** + [ + nth( + find( v( 10), v( 0)), + # 3) ==== + nth( v( 6), v( 1))])) ** + AbsEach + range( # 0, # 4) + (AbsExistsT + (Path( + nth( v( 10), v( 6)), + v( 0), + v( 7), + # 21, + # 13 ++++ v( 6) :: nil) ** + AbsAll + TreeRecords( v( 7)) + ([ + --( + v( 8), + v( 0) + )---> + (# 17 ++++ v( 3)) ==== + # 0] ** + [ + nth( v( 8), v( 0)) ==== + v( 0)] *\/* + [ + --( + v( 8), + v( 0) + )---> + (# 17 ++++ v( 3)) + inTree + v( 0)] ** + [ + --( + v( 8), + --( + v( 8), + v( 0) + )---> + (# 17 ++++ v( 3)) + )---> + (# 13 ++++ v( 3)) ==== + v( 0)]) ** + AbsAll + TreeRecords( v( 0)) + (AbsExists + range( # 0, # 4) + ([ + --( + v( 1), + v( 12) + )---> + (# 1 ++++ v( 0))] ** + ([ + nth( v( 4), v( 0)) ==== + # 2] *\/* + [ + nth( v( 4), v( 0)) ==== # 0]) *\/* + [ + --( + v( 1), + v( 12) + )---> + (# 5 ++++ v( 2))] ** + ([ + nth( v( 4), v( 0)) ==== + # 1] *\/* + [ + nth( v( 4), v( 0)) ==== # 0]))) ** + AbsAll + range( # 0, # 4) + (([ + --( + v( 0), + v( 1) )---> + (# 9 ++++ v( 0)) ==== + # 0] *\/* + [ + --( + v( 0), + v( 1) )---> + (# 1 ++++ v( 0))]) *\/* + [ + --( + v( 0), + v( 1) )---> + (# 5 ++++ v( 0))]) ** + AbsAll + range( # 0, # 4) + ([ + # 0 <<<< + --( + v( 1), + v( 7) )---> + (# 9 ++++ v( 0))] ** + ([ + # 0 <<<< + --( + v( 1), + v( 7) + )---> + (# 17 ++++ v( 0))] *\/* + [ + nth( v( 0), v( 2)) ==== + v( 1)]) *\/* + ([ + --( + v( 1), + v( 7) )---> + (# 9 ++++ v( 0)) ==== + # 0] ** + [ + --( + v( 1), + v( 7) + )---> + (# 17 ++++ v( 0)) ==== + # 0]) ** + [ + ~~ + nth( v( 5), v( 0)) ==== + v( 7)]) ** + SUM( + range( # 0, # 4), + # 0 <<<< + --( + v( 0), + v( 6) )---> + (# 9 ++++ v( 0)), + # 2) ** + (SUM( + range( # 0, # 4), + (--( + v( 6), + v( 4) )---> + (# 1 ++++ v( 0)) \\// + --( + v( 6), + v( 4) )---> + (# 5 ++++ v( 0))) //\\ + nth( v( 4), v( 0)) ==== # 0, + # 1) ** + AbsAll + range( # 0, # 4) + ([ + # 0 <<<< + --( + v( 1), + v( 7) )---> + (# 9 ++++ v( 0))] ** + [ + nth( v( 7), v( 0)) ==== # 0] *\/* + [ + # 0 <<<< nth( v( 7), v( 0))] *\/* + [ + --( + v( 1), + v( 7) )---> + (# 1 ++++ v( 0)) ==== + # 0] ** + [ + --( + v( 1), + v( 7) )---> + (# 5 ++++ v( 0)) ==== + # 0]) ** + AbsAll + range( # 0, # 4) + (AbsAll + range( # 0, # 4) + ((((([ + --( + v( 2), + v( 8) )---> + (# 9 ++++ v( 0))] *\/* + [ + --( + v( 2), + v( 8) )---> + (# 1 ++++ v( 0)) ==== + # 0] ** + [ + --( + v( 2), + v( 8) )---> + (# 5 ++++ v( 0)) ==== + # 0]) *\/* + [ + ~~ + --( + v( 2), + v( 8) )---> + (# 9 ++++ v( 1))]) *\/* + [ + nth( v( 6), v( 1)) ==== # 0]) *\/* + [v( 0) ==== v( 1)]) *\/* + AbsExists + TreeRecords( v( 4)) + (AbsExists + TreeRecords( + find( + v( 5), + v( 0))) + ([ + nth( + find( v( 6), v( 1)), + # 2) ==== + v( 3)] ** + [ + nth( + find( v( 6), v( 0)), + # 2) ==== + v( 1)])))) *\/* + AbsExists + range( # 0, # 4) + (([ + --( + v( 1), + v( 7) )---> + (# 1 ++++ v( 0))] ** + [ + nth( v( 5), v( 0)) ==== # 2] *\/* + [ + --( + v( 1), + v( 7) )---> + (# 5 ++++ v( 0))] ** + [ + nth( v( 1), v( 7)) ==== # 1]) ** + AbsAll + range( # 0, # 4) + ([ + # 0 ==== + nth( v( 6), v( 0))] *\/* + [ + --( + v( 2), + v( 8) )---> + (# 9 ++++ v( 0)) ==== + # 0] ** + [ + # 0 <<<< nth( v( 6), v( 0))] *\/* + AbsExists + TreeRecords( v( 4)) + (AbsExists + TreeRecords( + find( + v( 1), + v( 1))) + ([ + nth( + find( v( 6), v( 1)), + # 2) ==== + v( 2)] ** + ([ + # 0 <<<< + --( + v( 4), + v( 10) + )---> + (# 1 ++++ + nth( + find( v( 6), v( 0)), + # 2))] ** + [ + nth( + find( v( 6), v( 0)), + # 3) ==== + # 2] *\/* + [ + # 0 <<<< + --( + v( 4), + v( 10) + )---> + (# 5 ++++ + nth( + find( v( 6), v( 0)), + # 2))] ** + [ + nth( + find( v( 6), v( 0)), + # 3) ==== + # 1]))))) *\/* + AbsAll + range( # 0, # 4) + ([ + --( + v( 1), + v( 7) )---> + (# 9 ++++ v( 0)) ==== + # 0] *\/* + [ + nth( v( 5), v( 0)) ==== # 0])))) ** + AbsEmpty))))))))))))) nil s -> +realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (((TREE( !! (clauses), v( 0), # 21, # 0 :: nil) ** + TREE( !! (assignments_to_do_head), + v( 1), # 4, # 0 :: nil) ** + TREE( !! (stack), v( 2), # 4, # 0 :: nil) ** + ARRAY( !! (assignments), # 4, v( 3)) ** + ARRAY( !! (watches), # 4, v( 4))) ** + (AbsAll TreeRecords( v( 2)) + ([nth( find( v( 3), v( 0)), # 2) <<<< # 4] ** + ([nth( find( v( 3), v( 0)), # 3) ==== # 1] *\/* + [nth( find( v( 3), v( 0)), # 3) ==== # 2]) ** + [nth( v( 4), nth( find( v( 3), v( 0)), # 2)) ==== + nth( find( v( 3), v( 0)), # 3)] ** + AbsAll TreeRecords( nth( find( v( 3), v( 0)), # 2)) + ([~~ + nth( find( v( 4), v( 1)), # 2) ==== + nth( find( nth( find( v( 4), v( 1)), # 2), + v( 0)), # 2)])) ** + AbsAll range( # 0, # 4) + ([nth( v( 4), v( 0)) ==== # 0] *\/* + AbsExists TreeRecords( v( 3)) + ([nth( find( v( 4), v( 0)), # 2) ==== v( 1) //\\ + nth( find( v( 4), v( 0)), # 3) ==== + nth( v( 5), v( 1))]))) ** + AbsAll TreeRecords( v( 1)) + ([--( v( 2), v( 0) )---> # 1 ==== # 0 //\\ + nth( v( 2), v( 0)) ==== v( 0) \\// + --( v( 2), v( 0) )---> # 1 inTree v( 0) //\\ + --( v( 2), --( v( 2), v( 0) )---> # 1 )---> # 0 ==== + v( 0)]) ** + AbsEach range( # 0, # 4) + (AbsExistsT + (Path( nth( v( 4), v( 5)), + v( 0), v( 6), # 21, # 13 ++++ v( 5) :: nil) ** + AbsAll TreeRecords( v( 6)) + ([--( v( 7), v( 0) )---> (# 17 ++++ v( 3)) ==== + # 0 //\\ nth( v( 7), v( 0)) ==== v( 0) \\// + --( v( 7), v( 0) )---> (# 17 ++++ v( 3)) + inTree v( 0) //\\ + --( v( 7), + --( v( 7), v( 0) )---> (# 17 ++++ v( 3)) + )---> (# 13 ++++ v( 3)) ==== + v( 0)]) ** + AbsAll TreeRecords( v( 0)) + (AbsExists range( # 0, # 4) + ([--( v( 1), v( 6) )---> (# 1 ++++ v( 0)) //\\ + (nth( v( 4), v( 0)) ==== # 2 \\// + nth( v( 4), v( 0)) ==== # 0) \\// + --( v( 1), v( 6) )---> (# 5 ++++ v( 2)) //\\ + (nth( v( 4), v( 0)) ==== # 1 \\// + nth( v( 4), v( 0)) ==== # 0)])) ** + AbsAll range( # 0, # 4) + ([(--( v( 0), v( 1) )---> (# 9 ++++ v( 0)) ==== + # 0 \\// + --( v( 0), v( 1) )---> (# 1 ++++ v( 0))) \\// + --( v( 0), v( 1) )---> (# 5 ++++ v( 0))]) ** + AbsAll range( # 0, # 4) + ([~~ + --( v( 1), v( 6) )---> (# 9 ++++ v( 0)) ==== + # 0 //\\ + (~~ + --( v( 1), v( 6) )---> (# 17 ++++ v( 0)) ==== + # 0 \\// nth( v( 0), v( 2)) ==== v( 1)) \\// + (--( v( 1), v( 6) )---> (# 9 ++++ v( 0)) ==== + # 0 //\\ + --( v( 1), v( 6) )---> (# 17 ++++ v( 0)) ==== + # 0) //\\ ~~ nth( v( 4), v( 0)) ==== v( 6)]) ** + SUM( range( # 0, # 4), + ite( --( v( 0), v( 5) )---> (# 9 ++++ v( 0)), + # 1, # 0), # 2) ** + (SUM( range( # 0, # 4), + (--( v( 5), v( 3) )---> (# 1 ++++ v( 0)) \\// + --( v( 5), v( 3) )---> (# 5 ++++ v( 0))) //\\ + (ite( nth( v( 3), v( 0)) ==== # 0, # 1, # 0)), + # 1) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< + --( v( 1), v( 6) )---> (# 9 ++++ v( 0)) //\\ + nth( v( 6), v( 0)) ==== # 0 \\// + (# 0 <<<< nth( v( 6), v( 0)) \\// + --( v( 1), v( 6) )---> (# 1 ++++ v( 0)) ==== + # 0 //\\ + --( v( 1), v( 6) )---> (# 5 ++++ v( 0)) ==== + # 0)]) ** + AbsAll range( # 0, # 4) + (AbsAll range( # 0, # 4) + ([((((--( v( 2), + v( 7) )---> + (# 9 ++++ v( 0)) \\// + --( v( 2), + v( 7) )---> + (# 1 ++++ v( 0)) ==== + # 0 //\\ + --( v( 2), + v( 7) )---> + (# 5 ++++ v( 0)) ==== + # 0) \\// + ~~ + --( v( 2), v( 7) )---> (# 9 ++++ v( 1))) \\// + nth( v( 5), v( 1)) ==== # 0) \\// + nth( v( 5), v( 1)) ==== # 0) \\// + v( 0) ==== v( 1)] *\/* + AbsExists TreeRecords( v( 4)) + ([nth( find( v( 5), v( 0)), # 2) ==== + v( 2)] ** + AbsExists + TreeRecords( find( v( 5), v( 0))) + ([nth( find( v( 6), v( 0)), # 2) ==== + v( 1)])))) *\/* + AbsExists range( # 0, # 4) + ([--( v( 1), v( 6) )---> (# 1 ++++ v( 0)) //\\ + nth( v( 4), v( 0)) ==== # 2 \\// + --( v( 1), v( 6) )---> (# 5 ++++ v( 0)) //\\ + nth( v( 1), v( 6)) ==== # 1]) ** + AbsAll range( # 0, # 4) + ([# 0 ==== nth( v( 4), v( 0))] *\/* + [--( v( 1), v( 6) )---> (# 9 ++++ v( 0)) ==== + # 0] ** [# 0 <<<< nth( v( 4), v( 0))] *\/* + AbsExists TreeRecords( v( 3)) + ([nth( find( v( 4), v( 0)), # 2) ==== v( 1)]) ** + AbsExists TreeRecords( find( v( 0), v( 0))) + ([# 0 <<<< + --( v( 2), v( 7) + )---> (# 1 ++++ + nth( find( v( 4), v( 0)), # 2)) //\\ + nth( find( v( 4), v( 0)), # 3) ==== # 2 \\// + # 0 <<<< + --( v( 2), v( 7) + )---> (# 5 ++++ + nth( find( v( 4), v( 0)), # 2)) //\\ + nth( find( v( 4), v( 0)), # 3) ==== # 1])) *\/* + AbsAll range( # 0, # 4) + ([--( v( 1), v( 6) )---> (# 9 ++++ v( 0)) ==== + # 0 \\// nth( v( 4), v( 0)) ==== # 0]))))) ** + [!! (assignments_to_do_head) inTree v( 1)] ** + [nth( find( !! (assignments_to_do_head), v( 1)), # 1) ==== + # 0])))))) nil s. +Proof. + intros. + eapply simplifyEquiv2. compute. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. propagateExists. propagateExists. + propagateExists. + simplifyHyp H. simplifyHyp H. simplifyHyp H. simplifyHyp H. + simplifyHyp H. simplifyHyp H. simplifyHyp H. simplifyHyp H. propagateExistsHyp H. + + eapply stateImplication. + apply H. compute. reflexivity. compute. reflexivity. + prove_implication. + compute. reflexivity. compute. reflexivity. + intros. simpl. eapply emptyRealizeState. simpl. reflexivity. +Admitted. + +Theorem mergePredicateTheorem3 : +forall (eee : env) (hhh : heap) (bbb : list Value), + length bbb = 12 -> + realizeState + (([nth( v( 4), !! (varx)) ==== # 0] ** + ((([!! (ssss) ==== nth( v( 8), # 0)] ** + [!! (valuex) ==== v( 10)] ** + [!! (varx) ==== v( 9)] ** + ((((((AbsEmpty ** AbsEmpty ** AbsEmpty ** AbsEmpty) ** + ((([!! (varx) <<<< # 4] ** AbsEmpty) ** + (([!! (valuex) ==== # 1] *\/* [!! (valuex) ==== # 2]) ** + AbsEmpty) ** + ([v( 0) ==== !! (valuex)] ** + AbsAll TreeRecords( v( 8)) + ([nth( replacenth( v( 5), !! (varx), !! (valuex)), + nth( find( v( 9), v( 0)), # 2)) ==== + nth( find( v( 9), v( 0)), # 3)])) ** AbsEmpty) ** + AbsAll range( # 0, # 4) + ([nth( v( 5), v( 0)) ==== # 0] *\/* + [!! (varx) ==== v( 0)] *\/* + AbsExists TreeRecords( v( 9)) + ([nth( find( v( 10), v( 0)), # 2) ==== v( 1)] ** + [nth( find( v( 10), v( 0)), # 3) ==== nth( v( 6), v( 1))]))) ** + AbsEmpty ** + AbsEach range( # 0, # 4) + (AbsExistsT + (Path( nth( list( v( 9) + :: v( 10) + :: !! (varx) + :: !! (valuex) :: v( 13) :: nil), + replacenth( v( 6), !! (varx), !! (valuex))), + v( 0), v( 7), # 21, + # 13 ++++ replacenth( v( 6), !! (varx), !! (valuex)) + :: nil) ** + AbsAll TreeRecords( v( 7)) + ([--( v( 8), v( 0) )---> (# 17 ++++ !! (valuex)) ==== + # 0] ** [nth( v( 8), v( 0)) ==== v( 0)] *\/* + [--( v( 8), v( 0) )---> (# 17 ++++ !! (valuex)) + inTree v( 0)] ** + [--( v( 8), + --( v( 8), v( 0) )---> (# 17 ++++ !! (valuex)) + )---> (# 13 ++++ !! (valuex)) ==== + v( 0)]) ** + AbsAll TreeRecords( v( 0)) + (AbsExists range( # 0, # 4) + ([--( v( 1), + list( v( 11) + :: v( 12) + :: !! (varx) + :: !! (valuex) :: v( 15) :: nil) + )---> (# 1 ++++ v( 0))] ** + ([nth( !! (valuex), v( 0)) ==== # 2] *\/* + [nth( !! (valuex), v( 0)) ==== # 0]) *\/* + [--( v( 1), + list( v( 11) + :: v( 12) + :: !! (varx) + :: !! (valuex) :: v( 15) :: nil) + )---> (# 5 ++++ v( 2))] ** + ([nth( !! (valuex), v( 0)) ==== # 1] *\/* + [nth( !! (valuex), v( 0)) ==== # 0]))) ** + AbsAll range( # 0, # 4) + (([--( v( 0), v( 1) )---> (# 9 ++++ v( 0)) ==== # 0] *\/* + [--( v( 0), v( 1) )---> (# 1 ++++ v( 0))]) *\/* + [--( v( 0), v( 1) )---> (# 5 ++++ v( 0))]) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< + --( v( 1), replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0))] ** + ([# 0 <<<< + --( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 17 ++++ v( 0))] *\/* + [nth( v( 0), v( 2)) ==== v( 1)]) *\/* + ([--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)) ==== + # 0] ** + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 17 ++++ v( 0)) ==== + # 0]) ** + [~~ + nth( v( 5), v( 0)) ==== + replacenth( v( 7), !! (varx), !! (valuex))]) ** + SUM( range( # 0, # 4), + # 0 <<<< + --( v( 0), replacenth( v( 6), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)), # 2) ** + (SUM( range( # 0, # 4), + (--( replacenth( v( 6), !! (varx), !! (valuex)), + v( 4) )---> (# 1 ++++ v( 0)) \\// + --( replacenth( v( 6), !! (varx), !! (valuex)), + v( 4) )---> (# 5 ++++ v( 0))) //\\ + nth( v( 4), v( 0)) ==== # 0, + # 1) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< + --( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0))] ** + [nth( replacenth( v( 7), !! (varx), !! (valuex)), + v( 0)) ==== # 0] *\/* + [# 0 <<<< + nth( replacenth( v( 7), !! (varx), !! (valuex)), + v( 0))] *\/* + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 1 ++++ v( 0)) ==== + # 0] ** + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 5 ++++ v( 0)) ==== + # 0]) ** + AbsAll range( # 0, # 4) + (AbsAll range( # 0, # 4) + ((((([--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0))] *\/* + [--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 1 ++++ v( 0)) ==== + # 0] ** + [--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 5 ++++ v( 0)) ==== + # 0]) *\/* + [~~ + --( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 1))]) *\/* + [nth( v( 6), v( 1)) ==== # 0]) *\/* + [v( 0) ==== v( 1)]) *\/* + AbsExists (AbsConstVal (ListValue nil)) + (AbsExists + TreeRecords( find( !! (valuex), v( 0))) + ([nth( find( !! (valuex), v( 1)), # 2) ==== + v( 3)] ** + [nth( find( !! (valuex), v( 0)), # 2) ==== + v( 1)])))) *\/* + AbsExists range( # 0, # 4) + (([--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 1 ++++ v( 0))] ** + [nth( v( 5), v( 0)) ==== # 2] *\/* + [--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 5 ++++ v( 0))] ** + [nth( v( 1), + replacenth( v( 7), !! (varx), !! (valuex))) ==== + # 1]) ** + AbsAll range( # 0, # 4) + ([# 0 ==== nth( v( 6), v( 0))] *\/* + [--( v( 2), + replacenth( v( 8), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)) ==== + # 0] ** [# 0 <<<< nth( v( 6), v( 0))] *\/* + AbsExists (AbsConstVal (ListValue nil)) + ([nth( find( !! (valuex), v( 0)), # 2) ==== + v( 1)] ** + AbsExists TreeRecords( find( v( 1), v( 1))) + ([# 0 <<<< + --( v( 4), + replacenth( v( 10), !! (varx), !! (valuex)) + )---> (# 1 ++++ + nth( find( !! (valuex), v( 0)), # 2))] ** + [nth( find( !! (valuex), v( 0)), # 3) ==== + # 2] *\/* + [# 0 <<<< + --( v( 4), + replacenth( v( 10), !! (varx), !! (valuex)) + )---> (# 5 ++++ + nth( find( !! (valuex), v( 0)), # 2))] ** + [nth( find( !! (valuex), v( 0)), # 3) ==== + # 1])))) *\/* + AbsAll range( # 0, # 4) + ([--( v( 1), + replacenth( v( 7), !! (varx), !! (valuex)) + )---> (# 9 ++++ v( 0)) ==== + # 0] *\/* [nth( v( 5), v( 0)) ==== # 0]))))) ** + AbsEmpty ** AbsEmpty) ** + ([# 0 <<<< v( 7)] *\/* [v( 6) ==== # 0])) ** + [!! (valuex)]) ** [v( 3) ==== # 0]) ** + [!! (backtrack) ==== # 0]) ** [!! (stack) ==== !! (ssss)]) ** + [!! (have_var) ==== # 1]) ** AbsEmpty) ** + (ARRAY( !! (assignments), # 4, v( 4)) ** + [nth( find( !! (assignments_to_do_head), v( 2)), # 1) ==== # 0] ** + [!! (assignments_to_do_head) inTree v( 2)] ** + AbsAll TreeRecords( v( 2)) + ([--( v( 3), v( 0) )---> # 1 ==== # 0] ** + [nth( v( 3), v( 0)) ==== v( 0)] *\/* + [--( v( 3), v( 0) )---> # 1 inTree v( 0)] ** + [--( v( 3), --( v( 3), v( 0) )---> # 1 )---> # 0 ==== v( 0)]) ** + AbsAll TreeRecords( v( 8)) + (AbsAll TreeRecords( nth( find( v( 9), v( 0)), # 2)) + ([~~ + nth( find( v( 10), v( 1)), # 2) ==== + nth( find( nth( find( v( 10), v( 1)), # 2), v( 0)), # 2)])) ** + AbsAll TreeRecords( v( 8)) + ([nth( find( v( 9), v( 0)), # 3) ==== # 1] *\/* + [nth( find( v( 9), v( 0)), # 3) ==== # 2]) ** + AbsAll TreeRecords( v( 8)) ([nth( find( v( 9), v( 0)), # 2) <<<< # 4]) ** + ARRAY( !! (watches), # 4, v( 5)) ** + TREE( !! (stack), v( 8), # 4, # 0 :: nil) ** + TREE( !! (assignments_to_do_head), v( 2), # 4, # 0 :: nil) ** + TREE( !! (clauses), v( 0), # 21, # 0 :: nil) ** AbsEmpty) ** + build_equivs + ((!! (have_var) :: # 1 :: nil) + :: (!! (varx) :: v( 9) :: nil) + :: (v( 10) :: v( 0) :: !! (valuex) :: nil) + :: (nth( v( 8), # 0) :: !! (stack) :: !! (ssss) :: nil) + :: (nth( v( 4), !! (varx)) + :: nth( find( !! (assignments_to_do_head), v( 2)), # 1) + :: v( 3) :: !! (backtrack) :: # 0 :: nil) :: nil)) + bbb (eee, hhh) -> + realizeState + (AbsEach range( # 0, # 4) + (AbsExistsT + (Path( nth( v( 10), v( 6)), v( 0), v( 7), + # 21, # 13 ++++ v( 6) :: nil) ** + AbsAll TreeRecords( v( 7)) + ([--( v( 8), v( 0) )---> (# 17 ++++ v( 3)) ==== # 0] ** + [nth( v( 8), v( 0)) ==== v( 0)] *\/* + [--( v( 8), v( 0) )---> (# 17 ++++ v( 3)) inTree v( 0)] ** + [--( v( 8), --( v( 8), v( 0) )---> (# 17 ++++ v( 3)) + )---> (# 13 ++++ v( 3)) ==== v( 0)]) ** + AbsAll TreeRecords( v( 0)) + (AbsExists range( # 0, # 4) + ([--( v( 1), v( 12) )---> (# 1 ++++ v( 0))] ** + ([nth( v( 4), v( 0)) ==== # 2] *\/* + [nth( v( 4), v( 0)) ==== # 0]) *\/* + [--( v( 1), v( 12) )---> (# 5 ++++ v( 2))] ** + ([nth( v( 4), v( 0)) ==== # 1] *\/* + [nth( v( 4), v( 0)) ==== # 0]))) ** + AbsAll range( # 0, # 4) + (([--( v( 0), v( 1) )---> (# 9 ++++ v( 0)) ==== # 0] *\/* + [--( v( 0), v( 1) )---> (# 1 ++++ v( 0))]) *\/* + [--( v( 0), v( 1) )---> (# 5 ++++ v( 0))]) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< --( v( 1), v( 7) )---> (# 9 ++++ v( 0))] ** + ([# 0 <<<< --( v( 1), v( 7) )---> (# 17 ++++ v( 0))] *\/* + [nth( v( 0), v( 2)) ==== v( 1)]) *\/* + ([--( v( 1), v( 7) )---> (# 9 ++++ v( 0)) ==== # 0] ** + [--( v( 1), v( 7) )---> (# 17 ++++ v( 0)) ==== # 0]) ** + [~~ nth( v( 5), v( 0)) ==== v( 7)]) ** + SUM( range( # 0, # 4), + # 0 <<<< --( v( 0), v( 6) )---> (# 9 ++++ v( 0)), + # 2) ** + (SUM( range( # 0, # 4), + (--( v( 6), v( 4) )---> (# 1 ++++ v( 0)) \\// + --( v( 6), v( 4) )---> (# 5 ++++ v( 0))) //\\ + nth( v( 4), v( 0)) ==== # 0, # 1) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< --( v( 1), v( 7) )---> (# 9 ++++ v( 0))] ** + [nth( v( 7), v( 0)) ==== # 0] *\/* + [# 0 <<<< nth( v( 7), v( 0))] *\/* + [--( v( 1), v( 7) )---> (# 1 ++++ v( 0)) ==== # 0] ** + [--( v( 1), v( 7) )---> (# 5 ++++ v( 0)) ==== # 0]) ** + AbsAll range( # 0, # 4) + (AbsAll range( # 0, # 4) + ((((([--( v( 2), v( 8) )---> (# 9 ++++ v( 0))] *\/* + [--( v( 2), v( 8) )---> (# 1 ++++ v( 0)) ==== # 0] ** + [--( v( 2), v( 8) )---> (# 5 ++++ v( 0)) ==== # 0]) *\/* + [~~ --( v( 2), v( 8) )---> (# 9 ++++ v( 1))]) *\/* + [nth( v( 6), v( 1)) ==== # 0]) *\/* + [v( 0) ==== v( 1)]) *\/* + AbsExists TreeRecords( v( 4)) + (AbsExists TreeRecords( find( v( 5), v( 0))) + ([nth( find( v( 6), v( 1)), # 2) ==== v( 3)] ** + [nth( find( v( 6), v( 0)), # 2) ==== v( 1)])))) *\/* + AbsExists range( # 0, # 4) + (([--( v( 1), v( 7) )---> (# 1 ++++ v( 0))] ** + [nth( v( 5), v( 0)) ==== # 2] *\/* + [--( v( 1), v( 7) )---> (# 5 ++++ v( 0))] ** + [nth( v( 1), v( 7)) ==== # 1]) ** + AbsAll range( # 0, # 4) + ([# 0 ==== nth( v( 6), v( 0))] *\/* + [--( v( 2), v( 8) )---> (# 9 ++++ v( 0)) ==== # 0] ** + [# 0 <<<< nth( v( 6), v( 0))] *\/* + AbsExists TreeRecords( v( 4)) + (AbsExists TreeRecords( find( v( 1), v( 1))) + ([nth( find( v( 6), v( 1)), # 2) ==== v( 2)] ** + ([# 0 <<<< + --( v( 4), v( 10) + )---> (# 1 ++++ nth( find( v( 6), v( 0)), # 2))] ** + [nth( find( v( 6), v( 0)), # 3) ==== # 2] *\/* + [# 0 <<<< + --( v( 4), v( 10) + )---> (# 5 ++++ nth( find( v( 6), v( 0)), # 2))] ** + [nth( find( v( 6), v( 0)), # 3) ==== # 1]))))) *\/* + AbsAll range( # 0, # 4) + ([--( v( 1), v( 7) )---> (# 9 ++++ v( 0)) ==== # 0] *\/* + [nth( v( 5), v( 0)) ==== # 0]))))) bbb + (eee, empty_heap). +Proof. + admit. +Admitted. + + +Theorem mergeMergeTheorem2 : +mergeStates + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + ([nth( v( 2), !! (varx)) ==== # 0] ** + AbsExistsT + (((([!! (ssss) ==== nth( v( 8), # 0)] ** + [!! (valuex) ==== v( 10)] ** + [!! (varx) ==== v( 9)] ** + ((((((TREE( + !! (clauses), + v( 0), + # 21, + # 0 :: nil) ** + TREE( + !! + (assignments_to_do_head), + v( 2), + # 4, + # 0 :: nil) ** + TREE( + nth( v( 8), # 0), + v( 8), + # 4, + # 0 :: nil) ** + AbsEmpty ** + ARRAY( + !! (watches), + # 4, + v( 4))) ** + ((([!! (varx) <<<< # 4] ** + AbsAll + TreeRecords( v( 8)) + ([ + nth( + find( v( 9), v( 0)), + # 2) <<<< + # 4])) ** + (([!! (valuex) ==== # 1] *\/* + [!! (valuex) ==== # 2]) ** + AbsAll + TreeRecords( v( 8)) + ([ + nth( + find( v( 9), v( 0)), + # 3) ==== + # 1] *\/* + [ + nth( + find( v( 9), v( 0)), + # 3) ==== + # 2])) ** + ([ + nth( + replacenth( + v( 3), + !! (varx), + v( 0)), + !! (varx)) ==== + !! (valuex)] ** + AbsAll + TreeRecords( v( 8)) + ([ + nth( + replacenth( + v( 4), + !! (varx), + v( 1)), + nth( + find( v( 9), v( 0)), + # 2)) ==== + nth( + find( v( 9), v( 0)), + # 3)])) ** + AbsAll + TreeRecords( v( 8)) + ([ + ~~ + !! (varx) ==== + nth( + find( v( 9), v( 0)), + # 2)]) ** + AbsAll + TreeRecords( v( 8)) + (AbsAll + TreeRecords( + nth( + find( v( 9), v( 0)), + # 1)) + ([ + ~~ + nth( + find( v( 10), v( 1)), + # 2) ==== + nth( + find( + nth( + find( v( 10), v( 1)), + # 1), + v( 0)), + # 2)]))) ** + AbsAll + range( # 0, # 4) + ([ + nth( + replacenth( + v( 4), + !! (varx), + v( 1)), + v( 0)) ==== + # 0] *\/* + [!! (varx) ==== v( 0)] *\/* + AbsExists + TreeRecords( v( 9)) + ([ + nth( + find( v( 10), v( 0)), + # 2) ==== + v( 1)] ** + [ + nth( + find( v( 10), v( 0)), + # 3) ==== + nth( + replacenth( + v( 5), + !! (varx), + v( 2)), + v( 1))]))) ** + AbsAll + TreeRecords( v( 2)) + ([ + --( v( 3), v( 0) )---> # 1 ==== + # 0] ** + [ + nth( v( 3), v( 0)) ==== + v( 0)] *\/* + [ + --( v( 3), v( 0) )---> # 1 + inTree + v( 0)] ** + [ + --( + v( 3), + --( v( 3), v( 0) )---> # 1 + )---> + # 0 ==== + v( 0)]) ** + AbsEach + range( # 0, # 4) + (AbsExistsT + (Path( + nth( + list( + v( 8) + :: + v( 10) + :: + !! (varx) + :: + !! (valuex) :: + v( 13) :: nil), + replacenth( + v( 5), + !! (varx), + v( 2))), + v( 0), + v( 6), + # 21, + # 13 ++++ + replacenth( + v( 5), + !! (varx), + v( 2)) :: nil) ** + AbsAll + TreeRecords( v( 6)) + ([ + --( + v( 7), + v( 0) + )---> + (# 17 ++++ v( 3)) ==== + # 0] ** + [ + nth( v( 7), v( 0)) ==== + v( 0)] *\/* + [ + --( + v( 7), + v( 0) + )---> + (# 17 ++++ v( 3)) + inTree + v( 0)] ** + [ + --( + v( 7), + --( + v( 7), + v( 0) + )---> + (# 17 ++++ v( 3)) + )---> + (# 13 ++++ v( 3)) ==== + v( 0)]) ** + AbsAll + TreeRecords( v( 0)) + (AbsExists + range( # 0, # 4) + ([ + --( + v( 1), + list( + v( 10) + :: + v( 12) + :: + !! (varx) + :: + !! (valuex) :: + v( 15) :: nil) + )---> + (# 1 ++++ v( 0))] ** + ([ + nth( v( 4), v( 0)) ==== + # 2] *\/* + [ + nth( v( 4), v( 0)) ==== # 0]) *\/* + [ + --( + v( 1), + list( + v( 10) + :: + v( 12) + :: + !! (varx) + :: + !! (valuex) :: + v( 15) :: nil) + )---> + (# 5 ++++ v( 2))] ** + ([ + nth( v( 4), v( 0)) ==== + # 1] *\/* + [ + nth( v( 4), v( 0)) ==== # 0]))) ** + AbsAll + range( # 0, # 4) + (([ + --( + v( 0), + v( 1) )---> + (# 9 ++++ v( 0)) ==== + # 0] *\/* + [ + --( + v( 0), + v( 1) )---> + (# 1 ++++ v( 0))]) *\/* + [ + --( + v( 0), + v( 1) )---> + (# 5 ++++ v( 0))]) ** + AbsAll + range( # 0, # 4) + ([ + # 0 <<<< + --( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3)) + )---> + (# 9 ++++ v( 0))] ** + ([ + # 0 <<<< + --( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3)) + )---> + (# 17 ++++ v( 0))] *\/* + [ + nth( v( 0), v( 2)) ==== + v( 1)]) *\/* + ([ + --( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3)) + )---> + (# 9 ++++ v( 0)) ==== + # 0] ** + [ + --( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3)) + )---> + (# 17 ++++ v( 0)) ==== + # 0]) ** + [ + ~~ + nth( v( 5), v( 0)) ==== + replacenth( + v( 6), + !! (varx), + v( 3))]) ** + SUM( + range( # 0, # 4), + # 0 <<<< + --( + v( 0), + replacenth( + v( 5), + !! (varx), + v( 2)) + )---> + (# 9 ++++ v( 0)), + # 2) ** + (SUM( + range( # 0, # 4), + (--( + replacenth( + v( 5), + !! (varx), + v( 2)), + v( 4) )---> + (# 1 ++++ v( 0)) \\// + --( + replacenth( + v( 5), + !! (varx), + v( 2)), + v( 4) )---> + (# 5 ++++ v( 0))) //\\ + nth( v( 4), v( 0)) ==== # 0, + # 1) ** + AbsAll + range( # 0, # 4) + ([ + # 0 <<<< + --( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3)) + )---> + (# 9 ++++ v( 0))] ** + [ + nth( + replacenth( + v( 6), + !! (varx), + v( 3)), + v( 0)) ==== + # 0] *\/* + [ + # 0 <<<< + nth( + replacenth( + v( 6), + !! (varx), + v( 3)), + v( 0))] *\/* + [ + --( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3)) + )---> + (# 1 ++++ v( 0)) ==== + # 0] ** + [ + --( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3)) + )---> + (# 5 ++++ v( 0)) ==== + # 0]) ** + AbsAll + range( # 0, # 4) + (AbsAll + range( # 0, # 4) + ((((([ + --( + v( 2), + replacenth( + v( 7), + !! (varx), + v( 4)) + )---> + (# 9 ++++ v( 0))] *\/* + [ + --( + v( 2), + replacenth( + v( 7), + !! (varx), + v( 4)) + )---> + (# 1 ++++ v( 0)) ==== + # 0] ** + [ + --( + v( 2), + replacenth( + v( 7), + !! (varx), + v( 4)) + )---> + (# 5 ++++ v( 0)) ==== + # 0]) *\/* + [ + ~~ + --( + v( 2), + replacenth( + v( 7), + !! (varx), + v( 4)) + )---> + (# 9 ++++ v( 1))]) *\/* + [ + nth( v( 6), v( 1)) ==== # 0]) *\/* + [v( 0) ==== v( 1)]) *\/* + AbsExists + TreeRecords( v( 4)) + ([ + nth( + find( v( 5), v( 0)), + # 2) ==== + v( 2)] ** + AbsExists + TreeRecords( + find( + v( 5), + v( 0))) + ([ + nth( + find( v( 6), v( 0)), + # 2) ==== + v( 1)])))) *\/* + AbsExists + range( # 0, # 4) + ([ + --( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3)) + )---> + (# 1 ++++ v( 0))] ** + [ + nth( v( 5), v( 0)) ==== # 2] *\/* + [ + --( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3)) + )---> + (# 5 ++++ v( 0))] ** + [ + nth( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3))) ==== + # 1]) ** + AbsAll + range( # 0, # 4) + ([ + # 0 ==== + nth( v( 5), v( 0))] *\/* + [ + --( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3)) + )---> + (# 9 ++++ v( 0)) ==== + # 0] ** + [ + # 0 <<<< nth( v( 5), v( 0))] *\/* + AbsExists + TreeRecords( v( 3)) + ([ + nth( + find( v( 4), v( 0)), + # 2) ==== + v( 1)]) ** + AbsExists + TreeRecords( + find( + v( 0), + v( 0))) + ([ + # 0 <<<< + --( + v( 2), + replacenth( + v( 7), + !! (varx), + v( 4)) + )---> + (# 1 ++++ + nth( + find( v( 4), v( 0)), + # 2))] ** + [ + nth( + find( v( 4), v( 0)), + # 3) ==== + # 2] *\/* + [ + # 0 <<<< + --( + v( 2), + replacenth( + v( 7), + !! (varx), + v( 4)) + )---> + (# 5 ++++ + nth( + find( v( 4), v( 0)), + # 2))] ** + [ + nth( + find( v( 4), v( 0)), + # 3) ==== + # 1])) *\/* + AbsAll + range( # 0, # 4) + ([ + --( + v( 1), + replacenth( + v( 6), + !! (varx), + v( 3)) + )---> + (# 9 ++++ v( 0)) ==== + # 0] *\/* + [ + nth( v( 5), v( 0)) ==== # 0]))))) ** + [!! (assignments_to_do_head) + inTree + v( 2)] ** + [nth( + find( + !! + (assignments_to_do_head), + v( 2)), + # 1) ==== + # 0]) ** + [# 0 <<<< v( 6)]) ** + [v( 7) ==== # 0]) ** + [v( 5)]) ** + [!! (backtrack) ==== # 0]) ** + [!! (stack) ==== !! (ssss)]) ** + [!! (have_var) ==== # 1]) ** + ARRAY( !! (assignments), # 4, v( 3))))))))))))))) + ([~~ (convertToAbsExp (! iiii <<= ANum var_count))] ** haveVarInvariant) + invariant +. +Proof. + (*unfold haveVarInvariant. unfold invariant. unfold invariantCore. + unfold invariantCoreNoTail. unfold validTail. + unfold validBackPointers. unfold assignmentConsistent. + unfold watchVariablesExists. unfold watchVariablesLinkedIffSet. + unfold twoWatchVariables. unfold allButOneAssigned. unfold satisfyingAssignmentMade. + unfold watchAfterSatisfyingAssignment. + unfold watchesUnassigned. + unfold haveVarComponent. + unfold onlyOneUnassigned. unfold unassignedVariablesAreWatches. + unfold mostRecentAssignedIsWatch. + unfold coreStructures. + eapply breakRightClosureThm. simpl. reflexivity. + eapply breakRightClosureThm. simpl. reflexivity. + eapply breakRightClosureThm. simpl. reflexivity. + eapply mergeSimplifyRight. compute. reflexivity. + eapply mergeSimplifyRight. compute. reflexivity. + eapply mergeSimplifyRight. compute. reflexivity. + eapply mergeSimplifyRight. compute. reflexivity. + eapply mergeSimplifyRight. compute. reflexivity. + eapply mergeSimplifyRight. compute. reflexivity. + mergePropagateExistsRight. + eapply mergePropagateLeft. compute. reflexivity. + eapply mergeImplies. eapply ex_intro. split. + + startMerge. + + doMergeStates. + eapply DMImplyPredicates1. + eapply PESComposeRight. eapply PESComposeLeft. eapply PESComposeLeft. eapply PESComposeRight. eapply PESComposeLeft. eapply PESComposeLeft. eapply PESComposeRight. eapply PESComposeRight. eapply PESComposeLeft. eapply PESAll. + compute. reflexivity. + apply mergePredicateTheorem1. + eapply DMImplyPredicates1. + eapply PESComposeRight. eapply PESComposeLeft. eapply PESComposeLeft. eapply PESComposeRight. eapply PESComposeLeft. eapply PESComposeRight. eapply PESAll. + compute. reflexivity. + apply mergePredicateTheorem2. + eapply DMImplyPredicates1. + eapply PESComposeRight. eapply PESComposeLeft. eapply PESComposeLeft. eapply PESComposeRight. eapply PESComposeRight. eapply PESComposeRight. eapply PESEach. + compute. reflexivity. + apply mergePredicateTheorem3. + eapply DMFinish. solveAllPredicates. solveAllPredicates. + intros. + eapply breakTopClosureThm1. compute. reflexivity. + eapply breakTopClosureThm1. compute. reflexivity. + apply mergeFinalImplication1. apply H.*) + admit. +Admitted. + +Theorem mergeTheorem2UnfoldNotNull : + forall (s : (id -> nat) * (nat -> option nat)) (bindings : list Value), + realizeState + (([v( 8) ==== # 0] ** + [v( 6)] ** + [!! (backtrack) ==== # 0] ** + [!! (stack) ==== !! (ssss)] ** [!! (have_var) ==== # 1] ** AbsEmpty) ** + (((TREE( !! (clauses), v( 0), # 21, # 0 :: nil) ** + TREE( !! (assignments_to_do_head), v( 1), # 4, # 0 :: nil) ** + TREE( v( 7), v( 2), # 4, # 0 :: nil) ** + ARRAY( !! (assignments), # 4, v( 3)) ** + ARRAY( !! (watches), # 4, v( 4))) ** + (AbsAll TreeRecords( v( 2)) + ([nth( find( v( 3), v( 0)), # 2) <<<< # 4] ** + ([nth( find( v( 3), v( 0)), # 3) ==== # 1] *\/* + [nth( find( v( 3), v( 0)), # 3) ==== # 2]) ** + [nth( v( 4), nth( find( v( 3), v( 0)), # 2)) ==== + nth( find( v( 3), v( 0)), # 3)] ** + AbsAll TreeRecords( nth( find( v( 3), v( 0)), # 1)) + ([~~ + nth( find( v( 4), v( 1)), # 2) ==== + nth( find( nth( find( v( 4), v( 1)), # 1), v( 0)), # 2)])) ** + AbsAll range( # 0, # 4) + ([nth( v( 4), v( 0)) ==== # 0] *\/* + AbsExists TreeRecords( v( 3)) + ([nth( find( v( 4), v( 0)), # 2) ==== v( 1) //\\ + nth( find( v( 4), v( 0)), # 3) ==== nth( v( 5), v( 1))]))) ** + AbsAll TreeRecords( v( 1)) + ([--( v( 2), v( 0) )---> # 1 ==== # 0 //\\ + nth( v( 2), v( 0)) ==== v( 0) \\// + --( v( 2), v( 0) )---> # 1 inTree v( 0) //\\ + --( v( 2), --( v( 2), v( 0) )---> # 1 )---> # 0 ==== v( 0)]) ** + AbsEach range( # 0, # 4) + (AbsExistsT + (Path( nth( v( 4), v( 5)), v( 0), + v( 6), # 21, # 13 ++++ v( 5) :: nil) ** + AbsAll TreeRecords( v( 6)) + ([--( v( 7), v( 0) )---> (# 17 ++++ v( 3)) ==== # 0 //\\ + nth( v( 7), v( 0)) ==== v( 0) \\// + --( v( 7), v( 0) )---> (# 17 ++++ v( 3)) inTree v( 0) //\\ + --( v( 7), --( v( 7), v( 0) )---> (# 17 ++++ v( 3)) + )---> (# 13 ++++ v( 3)) ==== + v( 0)]) ** + AbsAll TreeRecords( v( 0)) + (AbsExists range( # 0, # 4) + ([--( v( 1), v( 6) )---> (# 1 ++++ v( 0)) //\\ + (nth( v( 4), v( 0)) ==== # 2 \\// + nth( v( 4), v( 0)) ==== # 0) \\// + --( v( 1), v( 6) )---> (# 5 ++++ v( 2)) //\\ + (nth( v( 4), v( 0)) ==== # 1 \\// + nth( v( 4), v( 0)) ==== # 0)])) ** + AbsAll range( # 0, # 4) + ([(--( v( 0), v( 1) )---> (# 9 ++++ v( 0)) ==== # 0 \\// + --( v( 0), v( 1) )---> (# 1 ++++ v( 0))) \\// + --( v( 0), v( 1) )---> (# 5 ++++ v( 0))]) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< --( v( 1), v( 6) )---> (# 9 ++++ v( 0)) //\\ + (# 0 <<<< --( v( 1), v( 6) )---> (# 17 ++++ v( 0)) \\// + nth( v( 0), v( 2)) ==== v( 1)) \\// + (--( v( 1), v( 6) )---> (# 9 ++++ v( 0)) ==== # 0 //\\ + --( v( 1), v( 6) )---> (# 17 ++++ v( 0)) ==== # 0) //\\ + ~~ nth( v( 4), v( 0)) ==== v( 6)]) ** + SUM( range( # 0, # 4), + # 0 <<<< --( v( 0), v( 5) )---> (# 9 ++++ v( 0)), + # 2) ** + (SUM( range( # 0, # 4), + (--( v( 5), v( 3) )---> (# 1 ++++ v( 0)) \\// + --( v( 5), v( 3) )---> (# 5 ++++ v( 0))) //\\ + nth( v( 3), v( 0)) ==== # 0, # 1) ** + AbsAll range( # 0, # 4) + ([# 0 <<<< --( v( 1), v( 6) )---> (# 9 ++++ v( 0)) //\\ + nth( v( 6), v( 0)) ==== # 0 \\// + (# 0 <<<< nth( v( 6), v( 0)) \\// + --( v( 1), v( 6) )---> (# 1 ++++ v( 0)) ==== # 0 //\\ + --( v( 1), v( 6) )---> (# 5 ++++ v( 0)) ==== # 0)]) ** + AbsAll range( # 0, # 4) + (AbsAll range( # 0, # 4) + ([((((--( v( 2), v( 7) )---> (# 9 ++++ v( 0)) \\// + --( v( 2), v( 7) )---> (# 1 ++++ v( 0)) ==== # 0 //\\ + --( v( 2), v( 7) )---> (# 5 ++++ v( 0)) ==== # 0) \\// + ~~ --( v( 2), v( 7) )---> (# 9 ++++ v( 1))) \\// + nth( v( 5), v( 1)) ==== # 0) \\// + nth( v( 5), v( 1)) ==== # 0) \\// + v( 0) ==== v( 1)] *\/* + AbsExists TreeRecords( v( 4)) + (AbsExists TreeRecords( find( v( 5), v( 0))) + ([nth( find( v( 6), v( 1)), # 2) ==== v( 3)] ** + [nth( find( v( 6), v( 0)), # 2) ==== v( 1)])))) *\/* + AbsExists range( # 0, # 4) + ([--( v( 1), v( 6) )---> (# 1 ++++ v( 0)) //\\ + nth( v( 4), v( 0)) ==== # 2 \\// + --( v( 1), v( 6) )---> (# 5 ++++ v( 0)) //\\ + nth( v( 1), v( 6)) ==== # 1] ** + AbsAll range( # 0, # 4) + ([# 0 ==== nth( v( 5), v( 0))] *\/* + [--( v( 2), v( 7) )---> (# 9 ++++ v( 0)) ==== # 0] ** + [# 0 <<<< nth( v( 5), v( 0))] *\/* + AbsExists TreeRecords( v( 4)) + (AbsExists TreeRecords( find( v( 1), v( 1))) + ([nth( find( v( 6), v( 1)), # 2) ==== v( 2)] ** + [# 0 <<<< + --( v( 4), v( 9) + )---> (# 1 ++++ nth( find( v( 6), v( 0)), # 2)) //\\ + nth( find( v( 6), v( 0)), # 3) ==== # 2 \\// + # 0 <<<< + --( v( 4), v( 9) + )---> (# 5 ++++ nth( find( v( 6), v( 0)), # 2)) //\\ + nth( find( v( 6), v( 0)), # 3) ==== # 1])))) *\/* + AbsAll range( # 0, # 4) + ([--( v( 1), v( 6) )---> (# 9 ++++ v( 0)) ==== # 0 \\// + nth( v( 4), v( 0)) ==== # 0]))))) ** + [!! (assignments_to_do_head) inTree v( 1)] ** + [nth( find( !! (assignments_to_do_head), v( 1)), # 1) ==== # 0]) ** + ([# 0 <<<< v( 7)] *\/* [v( 6) ==== # 0])) bindings s + -> + exists v : nat, nth 7 bindings NoValue = NatValue (S v). +Proof. + (*intros. Opaque nth. + simplifyHyp H. + eapply stateAssertionThm in H. compute in H. crunch. + remember (nth 7 bindings NoValue). destruct y. destruct n. omega. exists n. + reflexivity. inversion H18. inversion H18. inversion H18.*) + admit. +Admitted. + +Theorem stripUpdateVarLeftp + : forall left right m, + mergeStates (stripUpdateVar left) right m -> mergeStates left right m. +Proof. + admit. +Admitted. + +Theorem breakLeftClosureThmp + : forall left right m, + mergeStates (breakTopClosure left) right m -> mergeStates left right m. +Proof. + admit. +Admitted. + +Theorem mergePropagateLeftp + : forall P1 P2 P, + mergeStates (propagateExists nil P1) P2 P -> mergeStates P1 P2 P. +Proof. + admit. +Admitted. + +Theorem mergeSimplifyLeftp + : forall P1 P2 P, + mergeStates (simplifyState nil P1) P2 P -> mergeStates P1 P2 P. +Proof. + admit. +Admitted. + +Theorem stripUpdateWithLocLeftp + : forall P1 P2 P, + mergeStates (stripUpdateWithLoc P1) P2 P -> mergeStates P1 P2 P. +Proof. + admit. +Admitted. + +Theorem localizeExistsLeftp + : forall P1 P2 P, + mergeStates (localizeExists P1 0) P2 P -> mergeStates P1 P2 P. +Proof. + admit. +Admitted. + +Ltac compute_left := +match goal with +|- mergeStates ?L ?R ?M => + let l' := eval vm_compute in L in + replace L with l' ; [idtac | vm_cast_no_check (refl_equal l')] +end. + +Ltac compute_right := +match goal with +|- mergeStates ?L ?R ?M => + let r' := eval vm_compute in R in + replace R with r' ; [idtac | vm_cast_no_check (refl_equal r')] +end. + + +Theorem mergeTheorem2 : +mergeStates + (AbsUpdateLoc + (AbsUpdateVar + (AbsUpdateVar + (AbsMagicWand + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar + ([!! (backtrack)] ** + AbsUpdateVar ([# 1] ** loopInvariant) + have_var # 0) backtrack + # 0) varx !! (stack) ++++ # stack_var_offset) + valuex !! (stack) ++++ # stack_val_offset) + ssss !! (stack) ++++ # next_offset) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 3 |-> v( 4) ** + v( 0) ++++ # 2 |-> v( 3) ** + v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (stack) ==== v( 0)]))))))) + stack !! (ssss)) have_var # 1) !! (assignments) ++++ !! (varx) + # 0) + ([~~ (convertToAbsExp (! iiii <<= ANum var_count))] ** haveVarInvariant) + invariant. +Proof. + eapply stripUpdateVarLeftp. compute_left. + eapply breakLeftClosureThmp. compute_left. + eapply breakLeftClosureThmp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply unfold_merge1. + + unfoldHeap (AbsQVar 7). + + Transparent nth. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply stripUpdateWithLocLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply mergePropagateLeftp. compute_left. + eapply localizeExistsLeftp. compute_left. + eapply localizeExistsLeftp. compute_left. + eapply localizeExistsLeftp. compute_left. + eapply localizeExistsLeftp. compute_left. + eapply localizeExistsLeftp. compute_left. + eapply localizeExistsLeftp. compute_left. + eapply removeMagicWandLeft. compute. reflexivity. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + eapply mergeSimplifyLeftp. compute_left. + + eapply removeUpdateLocLeft. compute. reflexivity. + + intros. + eapply mergeTheorem2Index. apply H. + + apply mergeMergeTheorem2. Opaque nth. + + compute. intros. + eapply mergeTheorem2UnfoldNotNull. apply H. + admit. + + + +Admitted. + + + + +Theorem validRefTheorem1 : forall s n b, id -> nat -> realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + ([~~ !!(have_var) ==== #0] ** + pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState invariant + todo)))))))))))))) nil s -> NatValue n = + basicEval AbsPlusId + (NatValue (b todo) :: @NatValue unit next_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem2 : forall s n b, id -> nat -> realizeState + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + ([~~ !!(have_var) ==== #0] ** + pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) nil s -> NatValue n = + basicEval AbsPlusId + (NatValue (b todo) :: @NatValue unit prev_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem3 : forall s n b, id -> nat -> realizeState + ([~~ !!(assignments_to_do_tail) ==== #0] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + ([~~ !!(have_var) ==== #0] ** + pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) + !!(todo) ++++ #prev_offset #0) nil s -> NatValue n = + basicEval AbsPlusId + (NatValue (b assignments_to_do_head) :: @NatValue unit prev_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem3 : mergeStates + (AbsUpdateVar + ([!!(assignments_to_do_tail) ==== #0] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + ([~~ !!(have_var) ==== #0] ** + pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) + !!(todo) ++++ #prev_offset #0) assignments_to_do_tail + !!(todo)) + (AbsUpdateLoc + ([~~ !!(assignments_to_do_tail) ==== #0] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + ([~~ !!(have_var) ==== #0] ** + pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) + !!(todo) ++++ #prev_offset #0) + !!(assignments_to_do_head) ++++ #prev_offset + !!(todo)) invariant. +Proof. + admit. +Admitted. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/SatSolverAux1old.v b/PEDANTIC/SatSolverAux1old.v new file mode 100644 index 0000000..74177f4 --- /dev/null +++ b/PEDANTIC/SatSolverAux1old.v @@ -0,0 +1,1017 @@ +(********************************************************************************** + * The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic + * Traversal of Instruction Code) verification framework + * + * Developed by Kenneth Roe + * For more information, check out www.cs.jhu.edu/~roe + * + * SatSolverAux1.v + * This file contains the proof of correctness of a tree traversal algorithm using + * the PEDANTIC verification framework. + * + **********************************************************************************) + +Require Import Omega. +Require Export SfLib. +Require Export SfLibExtras. +Require Export ImpHeap. +Require Export AbsState. +Require Export AbsExecute. +Require Export AbsStateInstance. +Require Export Simplify. +Require Export Eqdep. +Require Export StateImplication. +Require Export Classical. +Require Export Unfold. +Require Export Fold. +Require Export merge. +Require Export ProgramTactics. +Require Export SatSolverDefs. +Require Export UpdateHelper. +Require Export ClosureHelper. +Require Export MagicWandExistsHelper. +Opaque haveVarInvariant. +Opaque basicEval. + +Set Printing Depth 200. + +Theorem precond1Core : + (exists st, realizeState + ([!!(backtrack)] ** + AbsClosure (invariant ** ([#0 <<<< v(2)] *\/* [v(5) ==== #0])) + (!!(clauses) + :: !!(assignments_to_do_head) + :: !!(stack) :: !!(assignments) :: !!(watches) :: nil)) nil + st) -> + (exists st, realizeState (AbsMagicWand + ([!!(backtrack)] ** + AbsClosure (invariant ** ([#0 <<<< v(2)] *\/* [v(5) ==== #0])) + (!!(clauses) + :: !!(assignments_to_do_head) + :: !!(stack) :: !!(assignments) :: !!(watches) :: nil)) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (!!(stack) ++++ #3 |-> v(3) ** + !!(stack) ++++ #2 |-> v(2) ** + !!(stack) ++++ #1 |-> v(1) ** !!(stack) |-> v(0))))))) + nil st). +Proof. + (*intros. destruct H. + eapply ex_intro. + eapply breakTopClosureThm1. unfold invariant. unfold invariantCore. + unfold invariantCoreNoTail. compute. reflexivity. + eapply breakTopClosureThm2 in H. Focus 2. unfold invariant. unfold invariantCore. + unfold invariantCoreNoTail. compute. reflexivity. + eapply breakTopClosureThm1. compute. reflexivity. + simplify. propagateExists. propagateExists. propagateExists. propagateExists. + propagateExists. + eapply unfold_rs1. + unfoldHeap (@AbsVar unit eq_unit (@basicEval unit) stack). + eapply breakTopClosureThm2 in H. Focus 2. compute. reflexivity. + simplifyHyp H. propagateExistsHyp H. propagateExistsHyp H. propagateExistsHyp H. + propagateExistsHyp H. propagateExistsHyp H. eapply unfold_rs2 in H. Focus 2. + unfoldHeap (@AbsVar unit eq_unit (@basicEval unit) stack). + simplify. simplifyHyp H. simplify. simplifyHyp H. + + + eapply magicWandStateExists. simpl. reflexivity. eapply ex_intro. + apply H. simpl. reflexivity. simpl. reflexivity. + simpl. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsId. reflexivity. + compute. reflexivity. + + Grab Existential Variables. apply x.*) + admit. +Admitted. + +Theorem preCond1 : forall x0, + realizeState + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar + ([!!(backtrack)] ** + AbsUpdateVar + ([#1] ** + AbsClosure loopInvariant + (!!(clauses) + :: !!(assignments_to_do_head) + :: !!(stack) + :: !!(assignments) :: !!(watches) :: nil)) + have_var #0) backtrack #0) + varx !!(stack) ++++ #stack_var_offset) + valuex !!(stack) ++++ #stack_val_offset) + ssss !!(stack) ++++ #next_offset) nil x0 -> + exists s, realizeState + (AbsMagicWand + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar + ([!!(backtrack)] ** + AbsUpdateVar + ([#1] ** + AbsClosure loopInvariant + (!!(clauses) + :: !!(assignments_to_do_head) + :: !!(stack) + :: !!(assignments) :: !!(watches) :: nil)) + have_var #0) backtrack #0) + varx !!(stack) ++++ #stack_var_offset) + valuex !!(stack) ++++ #stack_val_offset) + ssss !!(stack) ++++ #next_offset) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** [!!(stack) ==== v(0)]))))))) + nil s. +Proof. + (*intros. + decomposeUpdates. + simplifyTheHyp H. + decomposeUpdates. + + eapply simplifyExists. compute. reflexivity. + eapply simplifyExists. compute. reflexivity. + eapply simplifyExists. compute. reflexivity. + eapply simplifyExists. compute. reflexivity. + eapply simplifyExists. compute. reflexivity. + + eapply existsWithLoc. + eapply existsWithLoc. + eapply existsWithLoc. + eapply existsVar. + eapply existsVar. + eapply precond1Core. + eapply ex_intro. + apply H. + + +Grab Existential Variables. + apply x4. apply 0. apply x4. apply 0.*) + admit. +Admitted. + +Fixpoint isNat {ev} (v: @Value ev) := + match v with + | NatValue _ => True + | _ => False + end. + +Inductive ValueType := ListType | NatType | BoolType| AnyType. + +Fixpoint expValue {ev} {eq} {f} (vt : ValueType) (ex : @absExp ev eq f) (bindings: list (@Value ev)) (e : env) : @Value ev := + match vt with + | NatType => match ex with + | AbsConstVal x => x + | AbsVar x => NatValue (e x) + | AbsQVar x => nth x (rev bindings) NoValue + | AbsFun AbsPlusId (x::y::nil) => match expValue NatType x bindings e, + expValue NatType y bindings e with + | NatValue a, NatValue b => NatValue (a+b) + | _, _ => NoValue + end + | AbsFun AbsMinusId (x::y::nil) => match expValue NatType x bindings e, + expValue NatType y bindings e with + | NatValue a, NatValue b => NatValue (a-b) + | _, _ => NoValue + end + | AbsFun AbsTimesId (x::y::nil) => match expValue ListType x bindings e, + expValue NatType y bindings e with + | ListValue a, NatValue b => nth b a NoValue + | _, _ => NoValue + end + | AbsFun AbsNthId (x::y::nil) => match expValue NatType x bindings e, + expValue NatType y bindings e with + | NatValue a, NatValue b => NatValue (a*b) + | _, _ => NoValue + end + | _ => NoValue + end + | ListType => match ex with + | AbsQVar x => nth x (rev bindings) NoValue + | _ => NoValue + end + | _ => NoValue + end. + +Fixpoint mergeConditions cond1 cond2 := + match cond1, cond2 with + | None, None => None + | Some x, None => Some x + | None, Some x => Some x + | Some x, Some y => Some (x /\ y) + end. +Fixpoint expValid {ev} {eq} {f} (vt : ValueType) (ex : @absExp ev eq f) (bindings: list (@Value ev)) (e : env) : option Prop := + match vt with + | NatType => match ex with + | AbsConstVal _ => None + | AbsVar _ => None + | AbsQVar x => match nth x (rev bindings) NoValue with | NatValue _ => None | _ => Some False end + | AbsFun AbsPlusId (x::y::nil) => mergeConditions + (expValid vt x bindings e) + (expValid vt y bindings e) + | AbsFun AbsMinusId (x::y::nil) => mergeConditions + (expValid vt x bindings e) + (expValid vt y bindings e) + | AbsFun AbsTimesId (x::y::nil) => mergeConditions + (expValid vt x bindings e) + (expValid vt y bindings e) + | AbsFun AbsIteId (x::y::z::nil) => mergeConditions (mergeConditions + (expValid vt z bindings e) + (expValid vt y bindings e)) + (expValid BoolType x bindings e) + | _ => Some False + end + | AnyType => match ex with + | AbsConstVal _ => None + | AbsVar _ => None + | AbsQVar x => None + | _ => Some False + end + | _ => Some False + end. + +Fixpoint findTree {ev} {eq} {f} {t} {ac} (state : @absState ev eq f t ac) (e: @absExp ev eq f) : option (@absState ev eq f t ac) := + match state with + | AbsUpdateVar s a b => if @hasVarExp ev eq f e a then None else findTree s e + | AbsUpdateWithLoc s a b => if @hasVarExp ev eq f e a then None else findTree s e + | AbsStar a b => match findTree a e with + | Some x => Some x + | None => findTree b e + end + (*| AbsExistsT s => findTree s (N e)*) + | TREE(root,var,size,p) => if beq_absExp root e then Some (TREE(root,var,size,p)) else None + | _ => None + end. + +Fixpoint expAssertion {ev} {eq} {f} (ex : @absExp ev eq f) (bindings: list (@Value ev)) (e : env) := + match ex with + | AbsConstVal (NatValue (S _)) => True + | AbsConstVal _ => False + | AbsVar v => (e v) > 0 + | AbsQVar n => match nth n (rev bindings) NoValue with + | NatValue (S 0) => True + | _ => False + end + | AbsFun AbsLessId el => match map (absEval e bindings) el with + | (NatValue l::NatValue r::nil) => (l < r) + | _ => False + end + | AbsFun AbsEqualId el => match map (absEval e bindings) el with + | (NatValue l::NatValue r::nil) => (l = r) + | _ => False + end + | AbsFun AbsNotId (a::nil) => ~ (expAssertion a bindings e) + | AbsFun AbsAndId (a::b::nil) => (expAssertion a bindings e) /\ (expAssertion b bindings e) + | AbsFun AbsOrId (a::b::nil) => (expAssertion a bindings e) \/ (expAssertion b bindings e) + | AbsFun AbsMemberId (a::b::nil) => match expValid NatType a bindings e,expValue NatType a bindings e with + | None,NatValue x => match expValid AnyType b bindings e,expValue ListType b bindings e with + | None,y => Rmember x y=true + | Some p,y => p -> Rmember x y=true + end + | Some q,NatValue x => match expValid AnyType b bindings e,expValue ListType b bindings e with + | None,y => q -> Rmember x y=true + | Some p,y => q -> p -> Rmember x y=true + end + | _,_ => False + end + | AbsFun f el => match absEval e bindings ex with + | NatValue x => (x > 0) + | _ => False + end + end. + +Fixpoint isField {ev} {eq} {f} (ff : nat) (l : list (@absExp ev eq f)) (bindings : list (@Value ev)) (st : state) := + match l with + | nil => false + | (h::r) => match expValue NatType h bindings (fst st) with + | NatValue q=> if beq_nat q ff then true else isField ff r bindings st + | _ => isField ff r bindings st + end + end. + +Fixpoint foldAssertions {t} (b : t) (a : list (t -> Prop)) := + match a with + | f::r => (f b) /\ foldAssertions b r + | nil => True + end. + +Fixpoint extractList {t} (l : @Value t) := + match l with + | ListValue v => v + | _ => nil + end. + +Fixpoint stateAssertions {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (st : state) := + match s with + | AbsStar a b => (stateAssertions a st)++(stateAssertions b st) + | AbsMagicWand a b => (stateAssertions a st)++(stateAssertions b st) + | AbsOrStar a b => (fun bindings => ((foldAssertions bindings (stateAssertions a st)) \/ (foldAssertions bindings (stateAssertions b st))))::nil + | AbsUpdateVar s a b => (fun bindings => (match expValid NatType b bindings (fst st),(NatValue (fst st a)=(expValue NatType b bindings (fst st))) with + | Some x,y => (x -> y) + | None,y => y + end))::(fun bindings => (exists vv, (foldAssertions bindings (stateAssertions s (override (fst st) a vv,snd st)))))::nil + | AbsUpdateWithLoc s l (AbsFun AbsPlusId (aa::bb::nil)) => + (fun bindings => (exists vv, (foldAssertions bindings (stateAssertions s (override (fst st) l vv,snd st))))):: + match findTree s aa with + | Some (TREE(_,v,s,ff)) => (fun bindings => (expAssertion (AbsFun AbsLessId (bb::s::nil)) bindings (fst st) -> + forall ll vvv bbv, (NatValue ll=expValue NatType (AbsFun AbsPlusId (aa::bb::nil)) bindings (fst st) -> + (ListValue vvv)=expValue ListType v bindings (fst st) -> + NatValue bbv=expValue NatType bb bindings (fst st) -> + isField ll ff bindings st=false -> + (NatValue (fst st l)=(nth (bbv+1) vvv NoValue)))) /\ + (expAssertion (AbsFun AbsLessId (bb::s::nil)) bindings (fst st) -> + forall ll vvv qq bbv, (NatValue ll=expValue NatType (AbsFun AbsPlusId (aa::bb::nil)) bindings (fst st) -> + (ListValue vvv)=expValue ListType v bindings (fst st) -> + isField ll ff bindings st=true -> + NatValue bbv=expValue NatType bb bindings (fst st) -> + (ListValue qq=(nth (bbv+1) vvv NoValue)) -> + NatValue (fst st l)=(nth 0 qq NoValue)))) + | _ => (fun bindings => True) + end::nil + | AbsExistsT s => (fun bindings => (exists v, (foldAssertions (bindings++(v::nil)) (stateAssertions s st))))::nil + | AbsAll TreeRecords(v) s => map (fun (x : list Value -> Prop) => (fun bindings => forall vv vl, + expValue ListType v bindings (fst st)=vv-> + rangeSet vv=ListValue vl -> + forall v, (In (NatValue v) vl -> (x (bindings++((NatValue v)::nil)))))) (stateAssertions s st) + | AbsAll range(#ss,#ee) s => + map (fun (x : list Value -> Prop) => (fun bindings => forall v, (ss<=v -> v < ee -> x (bindings++((NatValue v)::nil))))) (stateAssertions s st) + | AbsAll range(ss,ee) s => (map (fun (x : list Value -> Prop) => (fun bindings => forall sss eee, + expValue NatType ss bindings (fst st)=NatValue sss-> + expValue NatType ee bindings (fst st)=NatValue eee-> + forall v, (sss<=v -> v < eee -> x (bindings++((NatValue v)::nil))))) (stateAssertions s st)) + | AbsAll e s => map (fun (x : list Value -> Prop) => (fun bindings => forall vl, absEval (env_p st) bindings e = (ListValue vl) -> + forall v, (In v vl -> x (bindings++(v::nil))))) (stateAssertions s st) + | [x] => (fun bindings => (@expAssertion ev eq f x bindings (fst st)))::nil + | ARRAY(!!root,#count,v(n)) => (fun bindings => exists h, + (match (nth n (rev bindings) NoValue) with + | ListValue vl => anyHeapv ((fst st) root) count h vl /\ (forall x v, h x = Some v -> (snd st) x = Some v) + | _ => False + end))::nil + | ARRAY(root,count,v) => (fun bindings => (exists r c vv h, + NatValue r=expValue NatType root bindings (fst st) -> + NatValue c=expValue NatType count bindings (fst st) -> + ListValue vv=expValue ListType v bindings (fst st) -> + anyHeapv r c h vv))::nil + | TREE(!!root,v(x),#count,(#next::nil)) => + (fun bindings => (exists h, + Tree (fst st root) count (next::nil) + (nth x (rev bindings) NoValue) h))::nil + | TREE(root,v,count,children) => (fun bindings => (forall c vr childrenr rootr countr, exists h, + childrenr = map (fun cc => expValue NatType cc bindings (fst st)) children -> + vr = expValue ListType v bindings (fst st) -> + NatValue countr = expValue NatType count bindings (fst st) -> + NatValue rootr = expValue NatType root bindings (fst st) -> + strip_nat_values childrenr c -> Tree rootr countr c vr h))::nil + + | _ => (fun x => True)::nil + end. + +Theorem stateAssertionThm: forall ev eq f t ac st b s, + @realizeState ev eq f t ac st b s -> foldAssertions b (@stateAssertions ev eq f t ac st s). +Proof. + admit. +Admitted. + +Theorem heapMap : forall t base size h l, @anyHeapv t base size h l -> (forall i, (i < size -> exists nv, (h (base+i)=Some nv /\ nth (i+1) l NoValue=NatValue nv))). +Proof. + admit. +Admitted. + +Theorem glue1 : forall (s : state), (let (x, _) := s in x)=env_p s. +Proof. + admit. +Admitted. + +Theorem glue2 : forall (s : state), (let (_, x) := s in x)=heap_p s. +Proof. + admit. +Admitted. + +Ltac decomposeStep := match goal with + | [ H: match ?Q with NatValue _ => _ | ListValue _ => False | NoValue => False | OtherValue _ => False end |- _ ] => remember Q; destruct Q + | [ H: match ?Q with NatValue _ => False | ListValue _ => _ | NoValue => False | OtherValue _ => False end |- _ ] => remember Q; destruct Q + | [ Q: False |- _ ] => inversion Q + end. + +Opaque numericRange. +Opaque rangeSet. +Opaque Rmember. +Opaque In. +Opaque nth. + +Theorem dumb1: forall x, x + 2 = S (S x). +Proof. + admit. +Admitted. + +Theorem dumb2: forall x, x + 2 + 1 = x + 3. +Proof. + admit. +Admitted. + +Theorem rangeSetIsList {ev} : forall a b c d e, @Tree ev a b c d e -> exists v, @ListValue ev v=rangeSet d. +Proof. + admit. +Admitted. + +Theorem rootInTree {ev} : forall a b c d e f, @Tree ev a b c d e -> @ListValue ev f = rangeSet d -> In (NatValue a) f. +Proof. admit. Admitted. + +Theorem rootIsRecord {ev}: forall a b c d e, @Tree ev a b c d e -> extractList d = findRecord a d. +Proof. admit. Admitted. + +Theorem dumb3 : forall x n, S x <= n -> x < n. Proof. admit. Admitted. + + +Theorem preCond2: forall (s : state) (n : nat) (b : id -> nat), realizeState + (AbsUpdateVar + (AbsUpdateVar + (AbsMagicWand + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar + ([!!(backtrack)] ** + AbsUpdateVar + ([#1] ** + AbsClosure loopInvariant + (!!(clauses) + :: !!(assignments_to_do_head) + :: !!(stack) + :: !!(assignments) + :: !!(watches) :: !!(backtrack) :: nil)) + have_var #0) backtrack + #0) varx !!(stack) ++++ #stack_var_offset) + valuex !!(stack) ++++ #stack_val_offset) + ssss !!(stack) ++++ #next_offset) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** [!!(stack) ==== v(0)]))))))) + stack !!(ssss)) have_var #1) + nil s -> NatValue n = + basicEval AbsPlusId + (NatValue (env_p s assignments) :: @NatValue unit (env_p s varx) :: nil) -> heap_p s n <> None. +Proof. + intros. eapply breakTopClosureThm2 in H. Focus 2. unfold loopInvariant. unfold invariant. + unfold invariantCore. unfold invariantCoreNoTail. compute. reflexivity. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + + eapply breakTopClosureThm2 in H. Focus 2. compute. reflexivity. + eapply propagateExistsEquiv1 in H. Focus 2. compute. reflexivity. + eapply propagateExistsEquiv1 in H. Focus 2. compute. reflexivity. + eapply propagateExistsEquiv1 in H. Focus 2. compute. reflexivity. + eapply propagateExistsEquiv1 in H. Focus 2. compute. reflexivity. + eapply propagateExistsEquiv1 in H. Focus 2. compute. reflexivity. + + eapply unfold_rs2 in H. Focus 2. + unfoldHeap (@AbsVar unit eq_unit (@basicEval unit) stack). + Transparent nth. + simplifyTheHyp H. + + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + eapply localizeExistsThm2 in H. Focus 2. compute. reflexivity. + + eapply clearMagicWandUpdateWithLocThm in H. Focus 2. compute. reflexivity. + eapply removeMagicWandThm in H. Focus 2. compute. reflexivity. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + simplifyTheHyp H. + + eapply stateAssertionThm in H. compute in H. + crunch. + + destruct x3. eapply dumb3 in H27. Transparent basicEval. simpl in H0. + inversion H0; subst; clear H0. rewrite <- glue1. + destruct x0. inversion H26. inversion H26; subst; clear H26. + + assert (exists nv, (x14 (((let (x, _) := s in x) assignments)+((let (x, _) := s in x) varx)) = Some nv /\ nth (((let (x, _) := s in x) varx)+1) l NoValue = NatValue nv)). + + eapply heapMap. apply H0. inversion H13; subst; clear H13. apply H27. + + inversion H3; subst; clear H3. + + assert(exists x, heap_p s ((let (x3, _) := s in x3) assignments + (let (x3, _) := s in x3) varx)=Some x). + eapply ex_intro. eapply H2. eapply H4. + + inversion H3; subst; clear H3. + + rewrite H5. intro X. inversion X. + + inversion H26. inversion H26. + + inversion H27. inversion H27. inversion H27. + + clear H. + compute. intros. + eapply stateAssertionThm in H. compute in H. crunch. + + remember ((let (x4, _) := s0 in x4) stack). destruct n0. inversion H15. + + eapply ex_intro. simpl. reflexivity. + + +Qed. + +Opaque basicEval. + +Theorem mergeTheorem1 : mergeStates + (AbsUpdateVar + (AbsUpdateVar + ([!!(ssss) ==== #0] ** + AbsUpdateWithLoc ([~~ #3 <<<< !!(iiii)] ** haveVarInvariant) + ssss !!(assignments) ++++ !!(iiii)) varx + !!(iiii)) have_var #1) + ([~~ !!(ssss) ==== #0] ** + AbsUpdateWithLoc ([~~ #3 <<<< !!(iiii)] ** haveVarInvariant) + ssss !!(assignments) ++++ !!(iiii)) haveVarInvariant. +Proof. + admit. +Admitted. + + +Theorem noResult1 : forall x0 st st' f, + ceval f st + (CIf (!ssss === A0) (varx ::= !iiii; have_var ::= A1) (SKIP)) + st' x0 -> x0 = NoResult. +Proof. + (*intros x0 st st' f H.*) + admit. +Admitted. + + +Theorem entailment1 : forall s : state, + realizeState (AbsUpdateVar haveVarInvariant iiii !!(iiii) ++++ #1) nil s -> + realizeState haveVarInvariant nil s. +Proof. + admit. +Admitted. + + +Theorem entailment2 : forall x0 : state, + realizeState + (AbsUpdateVar + (AbsUpdateVar + ([~~ !!(backtrack)] ** + AbsUpdateVar ([#1] ** invariant) have_var #0) + valuex #1) iiii #0) nil x0 -> realizeState haveVarInvariant nil x0. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem2 : mergeStates + (AbsUpdateLoc + (AbsUpdateVar + (AbsUpdateVar + (AbsMagicWand + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar + ([!!(backtrack)] ** + AbsUpdateVar ([#1] ** invariant) have_var #0) + backtrack #0) varx + !!(stack) ++++ #stack_var_offset) + valuex !!(stack) ++++ #stack_val_offset) + ssss !!(stack) ++++ #next_offset) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(stack) ==== v(0)]))))))) + stack !!(ssss)) have_var #1) !!(assignments) ++++ !!(varx) + #0) + (match NoResult with + | NoResult => [~~ (convertToAbsExp (!iiii <<= A3))] + | Return _ => AbsEmpty + | Exception _ _ => AbsEmpty + end ** haveVarInvariant) invariant. +Proof. + admit. +Admitted. + + + + +Theorem validRefTheorem1 : forall s n b, id -> nat -> realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + ([~~ !!(have_var) ==== #0] ** + pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState invariant + todo)))))))))))))) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b todo) :: @NatValue unit next_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem2 : forall s n b, id -> nat -> realizeState + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + ([~~ !!(have_var) ==== #0] ** + pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b todo) :: @NatValue unit prev_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem3 : forall s n b, id -> nat -> realizeState + ([~~ !!(assignments_to_do_tail) ==== #0] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + ([~~ !!(have_var) ==== #0] ** + pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) + !!(todo) ++++ #prev_offset #0) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b assignments_to_do_head) :: @NatValue unit prev_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem3 : mergeStates + (AbsUpdateVar + ([!!(assignments_to_do_tail) ==== #0] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + ([~~ !!(have_var) ==== #0] ** + pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) + !!(todo) ++++ #prev_offset #0) assignments_to_do_tail + !!(todo)) + (AbsUpdateLoc + ([~~ !!(assignments_to_do_tail) ==== #0] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + ([~~ !!(have_var) ==== #0] ** + pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) + !!(todo) ++++ #prev_offset #0) + !!(assignments_to_do_head) ++++ #prev_offset + !!(todo)) invariant. +Proof. + admit. +Admitted. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/SatSolverDefs.v b/PEDANTIC/SatSolverDefs.v index 6933bfc..ae7ffaf 100644 --- a/PEDANTIC/SatSolverDefs.v +++ b/PEDANTIC/SatSolverDefs.v @@ -25,7 +25,6 @@ Require Export Unfold. Require Export Fold. Require Export merge. Require Export ProgramTactics. -Opaque basicEval. (* ************************************************************************** * @@ -34,56 +33,56 @@ Opaque basicEval. * ***************************************************************************) -Notation "'clauses'" := (Id 1) (at level 1). -Notation "'assignments_to_do_head'" := (Id 2) (at level 1). -Notation "'assignments_to_do_tail'" := (Id 3) (at level 1). -Notation "'stack'" := (Id 4) (at level 1). -Notation "'assignments'" := (Id 5) (at level 1). -Notation "'watches'" := (Id 6) (at level 1). -Notation "'backtrack'" := (Id 7) (at level 1). -Notation "'iiii'" := (Id 8) (at level 1). -Notation "'varx'" := (Id 9) (at level 1). -Notation "'valuex'" := (Id 10) (at level 1). -Notation "'have_var'" := (Id 11) (at level 1). -Notation "'prop'" := (Id 12) (at level 1). -Notation "'todo'" := (Id 13) (at level 1). -Notation "'clause'" := (Id 14) (at level 1). -Notation "'ssss'" := (Id 15) (at level 1). -Notation "'vvvv'" := (Id 16) (at level 1). -Notation "'val'" := (Id 17) (at level 1). -Notation "'kkkk'" := (Id 18) (at level 1). -Notation "'nc'" := (Id 19) (at level 1). -Notation "'jjjj'" := (Id 20) (at level 1). -Notation "'non_watch'" := (Id 21) (at level 1). -Notation "'has_non_watch'" := (Id 22) (at level 1). -Notation "'skip'" := (Id 22) (at level 1). +Notation "'clauses'" := (Id 1001) (at level 1). +Notation "'assignments_to_do_head'" := (Id 1002) (at level 1). +Notation "'assignments_to_do_tail'" := (Id 1003) (at level 1). +Notation "'stack'" := (Id 1004) (at level 1). +Notation "'assignments'" := (Id 1005) (at level 1). +Notation "'watches'" := (Id 1006) (at level 1). +Notation "'backtrack'" := (Id 1007) (at level 1). +Notation "'iiii'" := (Id 1008) (at level 1). +Notation "'varx'" := (Id 1009) (at level 1). +Notation "'valuex'" := (Id 1010) (at level 1). +Notation "'have_var'" := (Id 1011) (at level 1). +Notation "'prop'" := (Id 1012) (at level 1). +Notation "'todo'" := (Id 1013) (at level 1). +Notation "'clause'" := (Id 1014) (at level 1). +Notation "'ssss'" := (Id 1015) (at level 1). +Notation "'vvvv'" := (Id 1016) (at level 1). +Notation "'val'" := (Id 1017) (at level 1). +Notation "'kkkk'" := (Id 1018) (at level 1). +Notation "'nc'" := (Id 1019) (at level 1). +Notation "'jjjj'" := (Id 1020) (at level 1). +Notation "'non_watch'" := (Id 1021) (at level 1). +Notation "'has_non_watch'" := (Id 1022) (at level 1). +Notation "'skip'" := (Id 1022) (at level 1). Definition var_count := 4. -Definition next_offset := 1. -Definition positive_lit_offset := 2. -Definition negative_lit_offset := var_count + 2. -Definition watch_var_offset := var_count * 2 + 2. -Definition watch_next_offset := var_count * 3 + 2. -Definition watch_prev_offset := var_count * 4 + 2. +Definition next_offset := 0. +Definition positive_lit_offset := 1. +Definition negative_lit_offset := var_count + 1. +Definition watch_var_offset := var_count * 2 + 1. +Definition watch_next_offset := var_count * 3 + 1. +Definition watch_prev_offset := var_count * 4 + 1. Definition sizeof_clause := var_count * 5 + 1. -Definition prev_offset := 2. -Definition todo_var_offset := 3. -Definition todo_val_offset := 4. -Definition todo_unit_offset := 5. +Definition prev_offset := 1. +Definition todo_var_offset := 2. +Definition todo_val_offset := 3. +Definition todo_unit_offset := 4. Definition sizeof_assignments_to_do := 5. -Definition stack_var_offset := 2. -Definition stack_val_offset := 3. -Definition stack_prop_offset := 4. +Definition stack_var_offset := 1. +Definition stack_val_offset := 2. +Definition stack_prop_offset := 3. Definition sizeof_assignment_stack := 4. Definition level := 0. -Definition domain {ev} {eq} {f} (x : @absExp ev eq f) : (@absExp ev eq f) := #0. +Definition domain (x : absExp) : absExp := #0. (*Notation "'ForAllRecords' x 'in' r ',' y" := (match level+1,v(level),(fun x => if beq_absExp x v(level) then r else domain x) with @@ -91,142 +90,148 @@ Definition domain {ev} {eq} {f} (x : @absExp ev eq f) : (@absExp ev eq f) := #0. | _,_,_ => AbsEmpty end) (at level 10). -Definition D {ev} {eq} {f} := ForAllRecords a in v(0), ([find(a,@domain ev eq f a)====#0]).*) +Definition D := ForAllRecords a in v(0), ([find(a,@domain ev eq f a)====#0]).*) (*Notation "x '====' y" := (AbsFun (Id 5) (x::y::nil)) (at level 6).*) -Definition coreStructures v0 v1 v2 v3 v4 : absStateBasic := - TREE(!!clauses,v0,#sizeof_clause,(#next_offset::nil)) ** - TREE(!!assignments_to_do_head,v1,#sizeof_assignment_stack,(#next_offset::nil)) ** - TREE(!!stack,v2,#sizeof_assignment_stack,(#next_offset::nil)) ** - ARRAY(!!assignments,#var_count,v3) ** - ARRAY(!!watches,#var_count,v4). - -Definition treeInArray (tr : nat) (ar : nat) (l : nat) : absStateBasic := - (AbsAll TreeRecords(v(tr)) - ([--(v(S(tr)),v(0))-->stack_var_offset <<<< #var_count] ** - ([--(v(S(tr)),v(0))-->stack_val_offset ==== #1] *\/* [--(v(S(tr)),v(0))-->stack_val_offset ==== #2]) ** - ([nth(v(S(ar)),--(v(S(tr)),v(0))-->stack_var_offset)====--(v(S(tr)),v(0))-->stack_val_offset]) ** - (AbsAll TreeRecords(nth(find(v(S(tr)),v(0)),#2)) - ([~~(--(v(S(S(tr))),v(1))-->stack_var_offset====--(nth(find(v(S(S(tr))),v(1)),#2),v(0))-->stack_var_offset)])))). - -Definition arrayInTree tr ar : absStateBasic := +Definition coreStructures : absState (* clauses assignments_to_do_head,stack,assignments,watches *) := + TREE(v(5),v(0),#sizeof_clause,(#(next_offset)::nil)) ** + TREE(v(6),v(1),#sizeof_assignment_stack,(#(next_offset)::nil)) ** + TREE(v(7),v(2),#sizeof_assignment_stack,(#(next_offset)::nil)) ** + ARRAY(v(8),#var_count,v(3)) ** + ARRAY(v(9),#var_count,v(4)). + +Definition treeInArray (* tr,ar,l *) : absState := + (AbsAll TreeRecords(v(0)) + ([--(v(S(0)),v(0))-->stack_var_offset <<<< #var_count] ** + ([--(v(S(0)),v(0))-->stack_val_offset ==== #1] *\/* [--(v(S(0)),v(0))-->stack_val_offset ==== #2]) ** + ([nth(v(S(1)),--(v(S(0)),v(0))-->stack_var_offset)====--(v(S(0)),v(0))-->stack_val_offset]) ** + (AbsAll TreeRecords(nth(find(v(S(0)),v(0)),#1)) + ([~~(--(v(S(S(0))),v(1))-->stack_var_offset====--(nth(find(v(S(S(0))),v(1)),#1),v(0))-->stack_var_offset)])))). + +Definition arrayInTree (* tr ar *) : absState := (AbsAll range(#0,#(var_count)) - ([nth(v(S(ar)),v(0))====#0] *\/* - AbsExists (TreeRecords(v(S(tr)))) - ([(--(v(S(S(tr))),v(0))-->stack_var_offset====v(1) //\\ - --(v(S(S(tr))),v(0))-->stack_val_offset====nth(v(S(S(ar))),v(1)))]) )). + ([nth(v(S(1)),v(0))====#0] *\/* + AbsExists (TreeRecords(v(S(0)))) + ([(--(v(S(S(0))),v(0))-->stack_var_offset====v(1) //\\ + --(v(S(S(0))),v(0))-->stack_val_offset====nth(v(S(S(1))),v(1)))]) )). -Definition treeEquivArray tr ar l : absStateBasic := - treeInArray tr ar l ** - arrayInTree tr ar. +Definition treeEquivArray (* tr ar l *) : absState := + treeInArray ** + arrayInTree. -Definition validBackPointers tr prev_offset next_offset : absStateBasic := - (AbsAll TreeRecords(v(tr)) +Definition validBackPointers (* tr *) prev_offset next_offset : absState := + (AbsAll TreeRecords(v(0)) ([ - (--(v(S(tr)),v(0))--->(prev_offset)====#0 //\\ (nth(v(S(tr)),v(0))====v(0)) \\// - (--(v(S(tr)),v(0))--->(prev_offset) inTree v(0) //\\ - --(v(S(tr)),--(v(S(tr)),v(0))--->(prev_offset))--->(next_offset)====v(0))) + (--(v(S(0)),v(0))--->(prev_offset)====#0 //\\ (nth(v(S(0)),v(0))====v(0)) \\// + (--(v(S(0)),v(0))--->(prev_offset) inTree v(0) //\\ + --(v(S(0)),--(v(S(0)),v(0))--->(prev_offset))--->(next_offset)====v(0))) ])). -Definition assignmentConsistent cl c a : absStateBasic := +Definition assignmentConsistent (*cl c a*) : absState := (AbsExists range(#0,#(var_count)) ([ -(--(N(cl),N(c))--->(#positive_lit_offset++++v(0)) //\\ - (nth(N(a),v(0))====#2 \\// nth(N(a),v(0))====#0)) \\// - (--(N(cl),N(c))--->(#negative_lit_offset++++v(6)) //\\ - (nth(N(a),v(0))====#1 \\// nth(N(a),v(0))====#0)) +(--(N(v(0)),N(v(1)))--->(#positive_lit_offset++++v(0)) //\\ + (nth(N(v(2)),v(0))====#2 \\// nth(N(v(2)),v(0))====#0)) \\// + (--(N(v(0)),N(v(1)))--->(#negative_lit_offset++++v(6)) //\\ + (nth(N(v(2)),v(0))====#1 \\// nth(N(v(2)),v(0))====#0)) ])). -Definition watchVariablesExists tr c : absStateBasic := +Definition watchVariablesExists (*tr c*) : absState := (AbsAll range(#0,#(var_count)) ([ - (--(tr,c)--->(#watch_var_offset++++v(0))====#0) \\// - (--(tr,c)--->(#positive_lit_offset++++v(0))) \\// - (--(tr,c)--->(#negative_lit_offset++++v(0)))])). + (--(v(0),v(1))--->(#watch_var_offset++++v(0))====#0) \\// + (--(v(0),v(1))--->(#positive_lit_offset++++v(0))) \\// + (--(v(0),v(1))--->(#negative_lit_offset++++v(0)))])). -Definition watchVariablesLinkedIffSet tr c a : absStateBasic := +Definition watchVariablesLinkedIffSet (*tr c a*) : absState := (AbsAll range(#0,#(var_count)) ([ - (~~(--(N(tr),N(c))--->(#watch_var_offset++++v(0))====#0) //\\ - (~~(--(N(tr),N(c))--->(#watch_prev_offset++++v(0))====#0) \\// + (~~(--(N(v(0)),N(v(1)))--->(#watch_var_offset++++v(0))====#0) //\\ + (~~(--(N(v(0)),N(v(1)))--->(#watch_prev_offset++++v(0))====#0) \\// nth(v(4),v(6))====v(5))) \\// - (--(N(tr),N(c))--->(#watch_var_offset++++v(0))====#0 //\\ - --(N(tr),N(c))--->(#watch_prev_offset++++v(0))====#0 //\\ - ~~(nth(N(a),v(0))====(N(c))))])). + (--(N(v(0)),N(v(1)))--->(#watch_var_offset++++v(0))====#0 //\\ + --(N(v(0)),N(v(1)))--->(#watch_prev_offset++++v(0))====#0 //\\ + ~~(nth(N(v(2)),v(0))====(N(v(1)))))])). -Definition twoWatchVariables tr c : absStateBasic := - (SUM(range(#0,#(var_count)),ite((--(tr,c)--->(#watch_var_offset++++v(0))),(#1),(#0)),#2)). +Definition twoWatchVariables (*tr c*) : absState := + (SUM(range(#0,#(var_count)),ite((--(v(0),v(1))--->(#watch_var_offset++++v(0))),(#1),(#0)),#2)). -Definition onlyOneUnassigned tr c a : absStateBasic := +Definition onlyOneUnassigned (*tr c a*) : absState := SUM(range(#0,#(var_count)), - (((--(N(tr),N(c))--->(#positive_lit_offset++++v(0))) \\// (--(N(tr),N(c))--->(#negative_lit_offset++++v(0)))) //\\ - ite(nth(a,v(0))====#0,#1,#0)), + (((--(N(v(0)),N(v(1)))--->(#positive_lit_offset++++v(0))) \\// (--(N(v(0)),N(v(1)))--->(#negative_lit_offset++++v(0)))) //\\ + ite(nth(v(2),v(0))====#0,#1,#0)), #1). -Definition unassignedVariablesAreWatches tr c a : absStateBasic := +Definition unassignedVariablesAreWatches (*tr c a*) : absState := (AbsAll range(#0,#(var_count)) - ([(#0<<<<--(N(tr),N(c))--->(#watch_var_offset++++v(0)) //\\ - (nth(a,v(0))====#0)) \\// + ([(#0<<<<--(N(v(0)),N(v(1)))--->(#watch_var_offset++++v(0)) //\\ + (nth(v(2),v(0))====#0)) \\// ( - ((#0<<<(#positive_lit_offset++++v(0))====#0 //\\ - --(N(tr),N(c))--->(#negative_lit_offset++++v(0))====#0))))])). + ((#0<<<(#positive_lit_offset++++v(0))====#0 //\\ + --(N(v(0)),N(v(1)))--->(#negative_lit_offset++++v(0))====#0))))])). -Definition mostRecentAssignedIsWatch tr c a st : absStateBasic := +Definition mostRecentAssignedIsWatch (*tr c a st*) : absState := (AbsAll range(#0,#(var_count)) (AbsAll range(#0,#(var_count)) - (([--(N(N(tr)),N(N(c)))--->(#watch_var_offset++++v(0)) \\// - ((((--(N(N(tr)),N(N(c)))--->(#positive_lit_offset++++v(0)))====#0 //\\ (--(N(N(tr)),N(N(c)))--->(#negative_lit_offset++++v(0))====#0)))) \\// - ~~(--(N(N(tr)),N(N(c)))--->(#watch_var_offset++++v(1))) \\// - nth(N(N(a)),v(1))====#0 \\// nth(N(N(a)),v(1))====#0 \\// v(0)====v(1)]) *\/* - (AbsExists TreeRecords(N(N(st))) - (([--(N(N(N(st))),v(0))-->stack_var_offset====v(2)]) ** - (AbsExists TreeRecords(find(N(N(N(st))),v(0))) - ([--(N(N(N(N(st)))),v(0))-->stack_var_offset====v(1)]))))))). - -Definition allButOneAssigned tr c a st : absStateBasic := - onlyOneUnassigned tr c a ** + (([--(N(N(v(0))),N(N(v(1))))--->(#watch_var_offset++++v(0)) \\// + ((((--(N(N(v(0))),N(N(v(1))))--->(#positive_lit_offset++++v(0)))====#0 //\\ (--(N(N(v(0))),N(N(v(1))))--->(#negative_lit_offset++++v(0))====#0)))) \\// + ~~(--(N(N(v(0))),N(N(v(1))))--->(#watch_var_offset++++v(1))) \\// + nth(N(N(v(2))),v(1))====#0 \\// nth(N(N(v(2))),v(1))====#0 \\// v(0)====v(1)]) *\/* + (AbsExists TreeRecords(N(N(v(3)))) + (([--(N(N(N(v(3)))),v(0))-->stack_var_offset====v(2)]) ** + (AbsExists TreeRecords(find(N(N(N(v(3)))),v(0))) + ([--(N(N(N(N(v(3))))),v(0))-->stack_var_offset====v(1)]))))))). + +Definition allButOneAssigned (*tr c a st*) : absState := + onlyOneUnassigned ** (* The one unassigned literal is a watch--needs fixing? *) - unassignedVariablesAreWatches tr c a ** - mostRecentAssignedIsWatch tr c a st. + unassignedVariablesAreWatches ** + mostRecentAssignedIsWatch. -Definition satisfyingAssignmentMade tr c a : absStateBasic := +Definition satisfyingAssignmentMade (*tr c a*) : absState := (AbsExists range(#0,#(var_count)) - ([(--(N(tr),N(c))--->(#positive_lit_offset++++v(0)) //\\ nth(N(a),v(0))====#2) \\// - (--(N(tr),N(c))--->(#negative_lit_offset++++v(0)) //\\ nth(N(tr),N(c))====#1)])). + ([(--(N(v(0)),N(v(1)))--->(#positive_lit_offset++++v(0)) //\\ nth(N(v(2)),v(0))====#2) \\// + (--(N(v(0)),N(v(1)))--->(#negative_lit_offset++++v(0)) //\\ nth(N(v(0)),N(v(1)))====#1)])). -Definition watchAfterSatisfyingAssignment tr c a st : absStateBasic := +Definition watchAfterSatisfyingAssignment (*tr c a st*) : absState := (AbsAll range(#0,#(var_count)) - ([#0====nth(N(a),v(0))] *\/* - ([--(N(tr),N(c))--->(#watch_var_offset++++v(0))====#0] ** - [#0<<<stack_var_offset====v(1)]) ** - (AbsExists TreeRecords(find(N(N(st)),v(0))) + ([#0====nth(N(v(2)),v(0))] *\/* + ([--(N(v(0)),N(v(1)))--->(#watch_var_offset++++v(0))====#0] ** + [#0<<<stack_var_offset====v(1)]) ** + (AbsExists TreeRecords(find(N(N(v(3))),v(0))) ([ -((#0 <<<< (--(N(N(tr)),N(N(c)))--->(#positive_lit_offset++++ --(N(N(st)),v(0))-->stack_var_offset))) //\\ (--(N(N(st)),v(0))-->stack_val_offset====#2)) +((#0 <<<< (--(N(N(v(0))),N(N(v(1))))--->(#positive_lit_offset++++ --(N(N(v(3))),v(0))-->stack_var_offset))) //\\ (--(N(N(v(3))),v(0))-->stack_val_offset====#2)) \\// -((#0 <<<< (--(N(N(tr)),N(N(c)))--->(#negative_lit_offset++++ --(N(N(st)),v(0))-->stack_var_offset))) //\\ - (--(N(N(st)),v(0))-->stack_val_offset====#1)) +((#0 <<<< (--(N(N(v(0))),N(N(v(1))))--->(#negative_lit_offset++++ --(N(N(v(3))),v(0))-->stack_var_offset))) //\\ + (--(N(N(v(3))),v(0))-->stack_val_offset====#1)) ])) ))). -Definition watchesUnassigned tr c a : absStateBasic := +Definition watchesUnassigned (*tr c a*) : absState := (AbsAll range(#0,#(var_count)) - ([--(N(tr),N(c))--->(#watch_var_offset++++v(0))====#0 \\// nth(N(a),v(0))====#0])). + ([--(N(v(0)),N(v(1)))--->(#watch_var_offset++++v(0))====#0 \\// nth(N(v(2)),v(0))====#0])). -Definition invariant: absStateBasic := - (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT ( - coreStructures v(0) v(1) v(2) v(3) v(4) ** +Definition watchesUnassignedOrV (*tr c a v*) : absState := + (AbsAll range(#0,#(var_count)) + ([--(N(v(0)),N(v(1)))--->(#watch_var_offset++++v(0))====#0 \\// v(0)====v(3) \\// nth(N(v(2)),v(0))====#0])). + +Definition validTail (*t v*) : absState := + [v(1) inTree v(0)] ** [--(v(1),v(0))-->next_offset====#0]. + +Definition invariantCoreNoTail (* v0 v1 v2 v3 v4 clauses assignments_to_do stack assignments watches *): absState := ( + (AbsClosure coreStructures (v(0)::v(1)::v(2)::v(3)::v(4)::v(5)::v(6)::v(7)::v(8)::v(9)::nil)) ** (* Assertions that the stack and assignments array contain the same set of assignments *) - treeEquivArray 2 3 var_count ** + (AbsClosure treeEquivArray (v(2)::v(3)::nil)) ** (* Assertion defining the prev pointer in the assignments_to_do doubly linked list *) - validBackPointers 1 (#prev_offset) (#next_offset) ** + (AbsClosure (validBackPointers (#prev_offset) (#next_offset)) (v(1)::nil)) ** (AbsEach range(#0,#(var_count)) (* Define the basic linked list connecting the watch variables inside the clauses linked list *) @@ -234,10 +239,10 @@ Definition invariant: absStateBasic := ((Path((nth(v(4),v(5))), v(0), v(6), #sizeof_clause, ((#watch_next_offset++++v(5))::nil))) ** (* Define the prev variable and the fact that if null we are at the head of the list *) - validBackPointers 6 (#watch_prev_offset++++v(5)) (#watch_next_offset++++v(5)) ** + (AbsClosure (validBackPointers (#watch_prev_offset++++v(5)) (#watch_next_offset++++v(5))) (v(6)::nil)) ** (AbsAll TreeRecords(v(0)) (* The current assignment is consistent with the clause *) - (assignmentConsistent v(0) v(5) v(3)) ** + (AbsClosure assignmentConsistent (v(0)::v(5)::v(3)::nil)) ** (* * make sure that if the watch_var field is non-zero (pointing to * a variable) that watch_next and watch_prev put this clause into @@ -245,29 +250,120 @@ Definition invariant: absStateBasic := * Also, for all watch variables, either positive_lit or negative_lit * is true. *) - watchVariablesExists v(0) v(5) ** - watchVariablesLinkedIffSet v(0) v(5) v(3) ** + (AbsClosure watchVariablesExists (v(0)::v(5)::nil)) ** + (AbsClosure watchVariablesLinkedIffSet (v(0)::v(5)::v(3)::nil)) ** (* Make sure there are precisely two watch variables per clause or all variables are watches, needs fixing? *) - twoWatchVariables v(0) v(5) ** + (AbsClosure twoWatchVariables (v(0)::v(5)::nil)) ** (* Watch variable invariant--case 1: All but one variable in the clause are assigned, any watch variable pointing to an assigned variable is pointing to a variable that was assigned after all other assigned variables in the clause. Also, one of the two watch variables points to the one unassigned variable *) - (allButOneAssigned v(0) v(5) v(3) v(2) *\/* + ((AbsClosure allButOneAssigned (v(0)::v(5)::v(3)::v(2)::nil)) *\/* (* Watch variable invariant case 2: One of the assignments already satisfies the clause, if a watch variable is assigned a value, then that value must be a satisfying assignment or occured after a satisfying assignment *) - ( satisfyingAssignmentMade v(0) v(5) v(3) ** - watchAfterSatisfyingAssignment v(0) v(5) v(3) v(2)) *\/* + ( (AbsClosure satisfyingAssignmentMade (v(0)::v(5)::v(3)::nil)) ** + (AbsClosure watchAfterSatisfyingAssignment (v(0)::v(5)::v(3)::v(2)::nil))) *\/* (* Watch variable invariant case 3: both watch variables point to unassigned variables *) - watchesUnassigned v(0) v(5) v(3)))))))))))). + (AbsClosure watchesUnassigned (v(0)::v(5)::v(3)::nil)))))))). -Definition finalState (x : nat) : absStateBasic := +Definition invariantCoreNoTailWL (* v0 v1 v2 v3 v4 clauses assignments_to_do stack assignments watches *) l v : absState := ( + (AbsClosure coreStructures (v(0)::v(1)::v(2)::v(3)::v(4)::v(5)::v(6)::v(7)::v(8)::v(9)::nil)) ** + (* Assertions that the stack and assignments array contain the same set + of assignments *) + (AbsClosure treeEquivArray (v(2)::v(3)::nil)) ** + (* Assertion defining the prev pointer in the assignments_to_do + doubly linked list *) + (AbsClosure (validBackPointers (#prev_offset) (#next_offset)) (v(1)::nil)) ** + (AbsEach range(#0,#(var_count)) + (* Define the basic linked list connecting the watch variables + inside the clauses linked list *) + (AbsExistsT + ((Path((nth(v(4),v(5))), v(0), v(6), #sizeof_clause, ((#watch_next_offset++++v(5))::nil))) ** + (* Define the prev variable and the fact that if null we are at + the head of the list *) + (AbsClosure (validBackPointers (#watch_prev_offset++++v(5)) (#watch_next_offset++++v(5))) (v(6)::nil)) ** + (AbsAll TreeRecords(v(0)) + (* The current assignment is consistent with the clause *) + (AbsClosure assignmentConsistent (v(0)::v(5)::v(3)::nil)) ** + (* + * make sure that if the watch_var field is non-zero (pointing to + * a variable) that watch_next and watch_prev put this clause into + * the linked list for the watch variable. + * Also, for all watch variables, either positive_lit or negative_lit + * is true. + *) + (AbsClosure watchVariablesExists (v(0)::v(5)::nil)) ** + (AbsClosure watchVariablesLinkedIffSet (v(0)::v(5)::v(3)::nil)) ** + (* Make sure there are precisely two watch variables per clause or all variables are watches, + needs fixing? *) + (AbsClosure twoWatchVariables (v(0)::v(5)::nil)) ** + (* Watch variable invariant--case 1: All but one variable in the + clause are assigned, any watch variable pointing to an assigned + variable is pointing to a variable that was assigned after all + other assigned variables in the clause. Also, one of the two + watch variables points to the one unassigned variable *) + ((AbsClosure allButOneAssigned (v(0)::v(5)::v(3)::v(2)::nil)) *\/* + (* Watch variable invariant case 2: One of the assignments already + satisfies the clause, if a watch variable is assigned a value, + then that value must be a satisfying assignment or occured + after a satisfying assignment *) + ( (AbsClosure satisfyingAssignmentMade (v(0)::v(5)::v(3)::nil)) ** + (AbsClosure watchAfterSatisfyingAssignment (v(0)::v(5)::v(3)::v(2)::nil))) *\/* + + (* Watch variable invariant case 3: both watch variables point to + unassigned variables *) + ([v(0) inTree l] ** (AbsClosure watchesUnassignedOrV (v(0)::v(5)::v(3)::v::nil))))))))). + +Definition iterate1 : absState := (AbsExists (range(#0,!!jjjj)) + ((([--(v(1),!!clause)--->(#watch_var_offset++++v(0))====#0]) ** + ([(nth(v(4),v(0))) ==== (#0)]) ** + [(!!non_watch) ==== (v(0))] ** + [(!!has_non_watch) ==== (#1)]) *\/* ([(!!has_non_watch) ==== (#0)]))). + +Definition iterate2 : absState := (AbsAll (range(#0,!!kkkk)) + ([(#0) ==== (--(v(1),!!clause)--->(#watch_var_offset++++v(0)))]) *\/* + [(#0) <<<< nth(v(4),v(0))] *\/* + ([(#0) ==== (--(v(1),!!clause)--->(#positive_lit_offset++++v(0)))] ** + [(#0) ==== (--(v(1),!!clause)--->(#negative_lit_offset++++v(0)))]) ** + ([(!!val) ==== (#1)] *\/* [(!!val) ==== (#2)])). + +Definition invariantCore: absState := + invariantCoreNoTail ** + (AbsClosure validTail (v(1)::v(6)::nil)). + +Definition invariantCoreWL : absState := + (invariantCoreNoTailWL (find(!!clause,v(0)))) (!!varx) ** + (AbsClosure validTail (v(1)::v(6)::nil)). + +Definition invariantWL (* clauses assignments_to_do stack assignments watches *) : absState := + (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsClosure invariantCoreWL((!!clauses)::(!!assignments_to_do_head)::(!!stack)::(!!assignments)::(!!watches)::v(0)::v(1)::v(2)::v(3)::v(4)::nil))))))). + +Definition invariantWLIT1 (* clauses assignments_to_do stack assignments watches *): absState := + (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsClosure (invariantCoreWL ** iterate1) ((!!clauses)::(!!assignments_to_do_head)::(!!stack)::(!!assignments)::(!!watches)::v(0)::v(1)::v(2)::v(3)::v(4)::nil))))))). + +Definition invariantWLIT2 (* clauses assignments_to_do stack assignments watches *) : absState := + (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsClosure (invariantCoreWL ** iterate2) ((!!clauses)::(!!assignments_to_do_head)::(!!stack)::(!!assignments)::(!!watches)::v(0)::v(1)::v(2)::v(3)::v(4)::nil))))))). + +Definition invariant (* clauses assignments_to_do stack assignments watches *) : absState := + (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsClosure invariantCore (v(0)::v(1)::v(2)::v(3)::v(4)::(!!clauses)::(!!assignments_to_do_head)::(!!stack)::(!!assignments)::(!!watches)::nil))))))). + +Definition loopInvariant (* clauses assignments_to_do stack assignments watches backtrack *) : absState := + (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsClosure (invariantCore ** ([(#0) <<<< v(7)] *\/* [v(10) ==== (#0)])) (v(0)::v(1)::v(2)::v(3)::v(4)::(!!clauses)::(!!assignments_to_do_head)::(!!stack)::(!!assignments)::(!!watches)::(!!backtrack)::nil))))))). + +Definition invariantNoTail (* clauses assignments_to_do stack assignments watches*) : absState := + (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsClosure invariantCoreNoTail (v(0)::v(1)::v(2)::v(3)::v(4)::(!!clauses)::(!!assignments_to_do_head)::(!!stack)::(!!assignments)::(!!watches)::nil))))))). + +Definition haveVarComponent : absState := ([v(11) ==== #0] *\/* [nth(v(3),(v(12)++++#1)) ==== #0]). + +Definition haveVarInvariant: absState := (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsClosure (invariantCore ** haveVarComponent) (v(0)::v(1)::v(2)::v(3)::v(4)::(!!clauses)::(!!assignments_to_do_head)::(!!stack)::(!!assignments)::(!!watches)::(!!backtrack)::(!!have_var)::(!!varx)::nil))))))). + +Definition finalState (x : nat) : absState := (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT (AbsExistsT ( TREE(!!clauses,v(0),#sizeof_clause,(#next_offset::nil)) ** TREE(!!assignments_to_do_head,v(1),#sizeof_assignment_stack,(#next_offset::nil)) ** @@ -390,7 +486,7 @@ Definition Program := ELSE valuex ::= A1; iiii ::= A0; - WHILE (!iiii <<= ANum(var_count-1)) DO + WHILE (!iiii <<= ANum(var_count)) DO (CLoad ssss (!assignments+++!iiii)); IF (!ssss===A0) THEN varx ::= !iiii; @@ -424,49 +520,52 @@ Definition Program := (CLoad prop (!assignments_to_do_tail+++ANum(todo_unit_offset))); (CLoad ssss (!assignments_to_do_tail+++ANum(prev_offset))); IF !ssss THEN - DELETE !ssss,(ANum(sizeof_assignments_to_do)); assignments_to_do_tail ::= !ssss; - (CStore (!ssss+++ANum(next_offset)) A0) + (CStore (!ssss+++ANum(next_offset-1)) A0); + DELETE !ssss,(ANum(sizeof_assignments_to_do)) ELSE + DELETE !ssss,(ANum(sizeof_assignments_to_do)); assignments_to_do_head ::= A0; assignments_to_do_tail ::= A0 FI; (CLoad ssss (!assignments+++!varx)); IF !ssss THEN - WHILE (!assignments_to_do_head) DO - (CLoad todo (!assignments_to_do_head +++ ANum(next_offset))); - DELETE !assignments_to_do_head,ANum(sizeof_assignments_to_do); - assignments_to_do_head ::= !todo - LOOP; - assignments_to_do_tail ::= A0; - (CLoad ssss (!stack +++ ANum(stack_prop_offset))); - (CLoad vvvv (!stack +++ ANum(stack_val_offset))); - WHILE (ALand (!stack) (ALor (!ssss) (!vvvv===A2))) DO - (CLoad kkkk (!stack +++ ANum(next_offset))); - (CLoad vvvv (!stack +++ ANum(stack_var_offset))); - (CStore (!assignments +++ !vvvv) A0); - DELETE !stack,ANum(sizeof_assignment_stack); - stack ::= !kkkk; + (CIf ((!ssss)===(!valuex)) + (SKIP) + (WHILE (!assignments_to_do_head) DO + (CLoad todo (!assignments_to_do_head +++ ANum(next_offset))); + DELETE !assignments_to_do_head,ANum(sizeof_assignments_to_do); + assignments_to_do_head ::= !todo + LOOP; + assignments_to_do_tail ::= A0; (CLoad ssss (!stack +++ ANum(stack_prop_offset))); - (CLoad vvvv (!stack +++ ANum(stack_val_offset))) - LOOP; - IF (!stack===A0) THEN - RETURN A0 - ELSE - SKIP - FI; - (CStore (!stack +++ ANum(stack_val_offset)) A2); - (CLoad vvvv (!stack +++ ANum(stack_var_offset))); - (CStore (!assignments +++ !vvvv) A2); - backtrack ::= A1 + (CLoad vvvv (!stack +++ ANum(stack_val_offset))); + WHILE (ALand (!stack) (ALor (!ssss) (!vvvv===A2))) DO + (CLoad kkkk (!stack +++ ANum(next_offset))); + (CLoad vvvv (!stack +++ ANum(stack_var_offset))); + (CStore (!assignments +++ !vvvv) A0); + DELETE !stack,ANum(sizeof_assignment_stack); + stack ::= !kkkk; + (CLoad ssss (!stack +++ ANum(stack_prop_offset))); + (CLoad vvvv (!stack +++ ANum(stack_val_offset))) + LOOP; + IF (!stack===A0) THEN + RETURN A0 + ELSE + SKIP + FI; + (CStore (!stack +++ ANum(stack_val_offset-1)) A2); + (CLoad vvvv (!stack +++ ANum(stack_var_offset))); + (CStore (!assignments +++ !vvvv) A2); + backtrack ::= A1)) ELSE (CStore (!assignments+++!varx) (!valuex)); NEW ssss,ANum(sizeof_assignment_stack); - (CStore (!ssss+++ANum(next_offset)) (!stack)); + (CStore (!ssss+++ANum(next_offset-1)) (!stack)); stack ::= !ssss; - (CStore (!ssss+++ANum(stack_var_offset)) (!varx)); - (CStore (!ssss+++ANum(stack_val_offset)) (!valuex)); - (CStore (!ssss+++ANum(stack_prop_offset)) (!prop)); + (CStore (!ssss+++ANum(stack_var_offset-1)) (!varx)); + (CStore (!ssss+++ANum(stack_val_offset-1)) (!valuex)); + (CStore (!ssss+++ANum(stack_prop_offset-1)) (!prop)); (CLoad clause (!watches+++!varx)); WHILE (!clause) DO (CLoad nc (!clause+++ANum(watch_next_offset)+++!varx)); @@ -529,10 +628,10 @@ Definition Program := FI ELSE kkkk ::= A0; - WHILE (!kkkk <<= ANum(var_count-1)) DO + WHILE (!kkkk <<= ANum(var_count)) DO (CLoad ssss (!clause +++ ANum(watch_var_offset) +++ !kkkk)); (CLoad jjjj (!assignments +++ !kkkk)); - IF (ALand (!ssss) (!jjjj)) THEN + IF (ALand (!ssss) ((!jjjj)===A0)) THEN vvvv ::= !kkkk; (CLoad ssss (!clause +++ ANum(positive_lit_offset) +++ !vvvv)); IF (!ssss) THEN @@ -560,9 +659,9 @@ Definition Program := assignments_to_do_tail ::= !todo FI; assignments_to_do_head ::= !todo; - (CStore (!todo +++ ANum(todo_var_offset)) (!vvvv)); - (CStore (!todo +++ ANum(todo_val_offset)) (!val)); - (CStore (!todo +++ ANum(todo_unit_offset)) A1) + (CStore (!todo +++ ANum(todo_var_offset-1)) (!vvvv)); + (CStore (!todo +++ ANum(todo_val_offset-1)) (!val)); + (CStore (!todo +++ ANum(todo_unit_offset-1)) A1) FI FI ELSE @@ -575,3 +674,83 @@ Definition Program := LOOP. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/SatSolverMain.v b/PEDANTIC/SatSolverMain.v index df928ba..3a6ed34 100644 --- a/PEDANTIC/SatSolverMain.v +++ b/PEDANTIC/SatSolverMain.v @@ -26,17 +26,1602 @@ Require Export Fold. Require Export merge. Require Export ProgramTactics. Require Export SatSolverDefs. +Require Export SatSolverAux1. + Opaque basicEval. +Opaque invariant. +Opaque haveVarInvariant. Definition x := 1. +Theorem varNeqBacktrack : varx <> backtrack. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem4 : forall s n b, id -> nat -> realizeState (AbsUpdateVar invariant assignments_to_do_head !!(todo)) + nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b todo) :: @NatValue unit todo_var_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + + +Theorem validRefTheorem5 : forall s n b, id -> nat -> realizeState + (AbsUpdateLoc + (AbsUpdateVar invariant assignments_to_do_head !!(todo)) + !!(todo) ++++ #todo_var_offset !!(varx)) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b todo) :: @NatValue unit todo_val_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + +Theorem validRefTheorem7: forall s n b, id -> nat -> realizeState + (AbsUpdateVar + ([!!(ssss)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + ([!!(assignments_to_do_tail)] ** invariant) + varx !!(assignments_to_do_tail) ++++ #todo_var_offset) + valuex !!(assignments_to_do_tail) ++++ #todo_val_offset) + prop !!(assignments_to_do_tail) ++++ #todo_unit_offset) + ssss !!(assignments_to_do_tail) ++++ #prev_offset) + assignments_to_do_tail !!(ssss)) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b ssss) :: @NatValue unit next_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + + + +Theorem existsTheorem1 : exists s : state, + realizeState + (AbsMagicWand + (AbsUpdateLoc + (AbsUpdateVar + ([!!(ssss)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + ([!!(assignments_to_do_tail)] ** invariant) + varx + !!(assignments_to_do_tail) ++++ #todo_var_offset) + valuex + !!(assignments_to_do_tail) ++++ #todo_val_offset) + prop !!(assignments_to_do_tail) ++++ #todo_unit_offset) + ssss !!(assignments_to_do_tail) ++++ #prev_offset) + assignments_to_do_tail !!(ssss)) !!(ssss) ++++ #next_offset + #0) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** [!!(ssss) ==== v(0)])))))))) + nil s. +Proof. + admit. +Admitted. + + +Theorem existsTheorem2 : exists s : state, + realizeState + (AbsMagicWand + ([~~ !!(ssss)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + ([!!(assignments_to_do_tail)] ** invariant) + varx !!(assignments_to_do_tail) ++++ #todo_var_offset) + valuex !!(assignments_to_do_tail) ++++ #todo_val_offset) + prop !!(assignments_to_do_tail) ++++ #todo_unit_offset) + ssss !!(assignments_to_do_tail) ++++ #prev_offset) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** [!!(ssss) ==== v(0)])))))))) + nil s. +Proof. + + + + admit. +Admitted. + + +Theorem mergeTheorem4 : mergeStates + (AbsMagicWand + (AbsUpdateLoc + (AbsUpdateVar + ([!!(ssss)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + ([!!(assignments_to_do_tail)] ** invariant) + varx + !!(assignments_to_do_tail) ++++ #todo_var_offset) + valuex + !!(assignments_to_do_tail) ++++ #todo_val_offset) + prop !!(assignments_to_do_tail) ++++ #todo_unit_offset) + ssss !!(assignments_to_do_tail) ++++ #prev_offset) + assignments_to_do_tail !!(ssss)) !!(ssss) ++++ #next_offset + #0) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** [!!(ssss) ==== v(0)])))))))) + (AbsUpdateVar + (AbsUpdateVar + (AbsMagicWand + ([~~ !!(ssss)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + ([!!(assignments_to_do_tail)] ** invariant) + varx + !!(assignments_to_do_tail) ++++ #todo_var_offset) + valuex + !!(assignments_to_do_tail) ++++ #todo_val_offset) + prop !!(assignments_to_do_tail) ++++ #todo_unit_offset) + ssss !!(assignments_to_do_tail) ++++ #prev_offset) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(ssss) ==== v(0)])))))))) + assignments_to_do_head #0) assignments_to_do_tail + #0) invariant. +Proof. + admit. +Admitted. + + +Theorem existsTheorem3 : exists s : state, + realizeState + (AbsMagicWand + (AbsUpdateWithLoc ([!!(assignments_to_do_head)] ** invariantNoTail) + todo !!(assignments_to_do_head) ++++ #next_offset) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(assignments_to_do_head) ==== v(0)])))))))) + nil s. +Proof. + + + + + admit. +Admitted. + + +Theorem entailment3 : forall s : state, + realizeState + (AbsUpdateVar + (AbsMagicWand + (AbsUpdateWithLoc + ([!!(assignments_to_do_head)] ** invariantNoTail) + todo !!(assignments_to_do_head) ++++ #next_offset) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(assignments_to_do_head) ==== v(0)])))))))) + assignments_to_do_head !!(todo)) nil s -> + realizeState invariantNoTail nil s. +Proof. + + + admit. +Admitted. + + +Theorem entailment4 : forall x0 : state, + realizeState + ([~~ !!(ssss) ==== !!(valuex)] ** + [!!(ssss)] ** + AbsUpdateWithLoc invariant ssss !!(assignments) ++++ !!(varx)) nil x0 -> + realizeState invariantNoTail nil x0. +Proof. + + + admit. +Admitted. + + +Theorem validRefTheorem8 : forall s n b, id -> nat -> realizeState + (AbsUpdateWithLoc + (AbsUpdateWithLoc + ([!!(stack) //\\ (!!(ssss) \\// !!(vvvv) ==== #2)] ** invariant) + kkkk !!(stack) ++++ #next_offset) vvvv + !!(stack) ++++ #stack_var_offset) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b assignments) :: @NatValue unit (b vvvv) :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem existsTheorem4 : exists s : state, + realizeState + (AbsMagicWand + (AbsUpdateLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + ([!!(stack) //\\ (!!(ssss) \\// !!(vvvv) ==== #2)] ** + invariant) kkkk !!(stack) ++++ #next_offset) + vvvv !!(stack) ++++ #stack_var_offset) + !!(assignments) ++++ !!(vvvv) #0) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** [!!(stack) ==== v(0)]))))))) + nil s. +Proof. + admit. +Admitted. + + +Theorem entailment5: forall s : state, + realizeState + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar + (AbsMagicWand + (AbsUpdateLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc + ([!!(stack) //\\ (!!(ssss) \\// !!(vvvv) ==== #2)] ** + invariant) kkkk !!(stack) ++++ #next_offset) + vvvv !!(stack) ++++ #stack_var_offset) + !!(assignments) ++++ !!(vvvv) #0) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(stack) ==== v(0)]))))))) + stack !!(kkkk)) ssss !!(stack) ++++ #stack_prop_offset) + vvvv !!(stack) ++++ #stack_val_offset) nil s -> + realizeState invariant nil s. +Proof. + + + + admit. +Admitted. + + +Theorem entailment6 : forall x0 : state, + realizeState + (AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar ([~~ !!(assignments_to_do_head)] ** invariantNoTail) + assignments_to_do_tail #0) ssss + !!(stack) ++++ #stack_prop_offset) vvvv + !!(stack) ++++ #stack_val_offset) nil x0 -> + realizeState invariant nil x0. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem9 : forall s n b, id -> nat -> realizeState + ([~~ !!(stack) ==== #0] ** + [~~ (convertToAbsExp (ALand (!stack) (ALor (!ssss) (!vvvv === A2))))] ** + invariant) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b stack) :: @NatValue unit stack_val_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem10 : forall s n b, id -> nat -> realizeState + (AbsUpdateWithLoc + (AbsUpdateLoc + ([~~ !!(stack) ==== #0] ** + [~~ + (convertToAbsExp + (ALand (!stack) (ALor (!ssss) (!vvvv === A2))))] ** + invariant) !!(stack) ++++ #stack_val_offset + #2) vvvv !!(stack) ++++ #stack_var_offset) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b assignments) :: @NatValue unit (b vvvv) :: nil) -> heap_p s n <> None. +Proof. + intros s n b H H0. + + + admit. +Admitted. + + +Theorem mergeReturn1 : mergeReturnStates invariant + ([!!(stack) ==== #0] ** + [~~ (convertToAbsExp (ALand (!stack) (ALor (!ssss) (!vvvv === A2))))] ** + invariant) invariant (#0 :: #1 :: nil) (#0 :: nil) + (#0 :: #1 :: nil). +Proof. + + + + admit. +Admitted. + + +Theorem mergeReturn2 : mergeReturnStates invariant invariant invariant + (#0 :: #1 :: nil) (#0 :: #1 :: nil) (#0 :: #1 :: nil). +Proof. + admit. +Admitted. + + +Theorem mergeTheorem5 : mergeStates + ([!!(ssss) ==== !!(valuex)] ** + [!!(ssss)] ** + AbsUpdateWithLoc invariant ssss !!(assignments) ++++ !!(varx)) + (AbsUpdateVar + (AbsUpdateLoc + (AbsUpdateWithLoc + (AbsUpdateLoc + ([~~ !!(stack) ==== #0] ** + [~~ + (convertToAbsExp + (ALand (!stack) (ALor (!ssss) (!vvvv === A2))))] ** + invariant) !!(stack) ++++ #stack_val_offset + #2) vvvv !!(stack) ++++ #stack_var_offset) + !!(assignments) ++++ !!(vvvv) #2) backtrack + #1) invariant. +Proof. + + + admit. +Admitted. + + +Theorem validRefTheorem11 : forall s n b, id -> nat -> realizeState + ([~~ !!(ssss)] ** + AbsUpdateWithLoc invariant ssss !!(assignments) ++++ !!(varx)) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b assignments) :: @NatValue unit (b varx) :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem12 : forall s n b, id -> nat -> realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(ssss) ==== v(0)] ** + AbsExistsT + (AbsUpdateLoc + ([~~ v(5)] ** + AbsUpdateWithLoc + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState invariant + ssss)))))) + ssss !!(assignments) ++++ !!(varx)) + !!(assignments) ++++ !!(varx) + !!(valuex)))))))) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b ssss) :: @NatValue unit next_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem13 : forall s n b, id -> nat -> realizeState + (AbsUpdateVar + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(ssss) ==== v(0)] ** + AbsExistsT + (AbsUpdateLoc + ([~~ v(5)] ** + AbsUpdateWithLoc + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + ssss)))))) + ssss !!(assignments) ++++ !!(varx)) + !!(assignments) ++++ !!(varx) + !!(valuex)))))))) + !!(ssss) ++++ #next_offset !!(stack)) + stack !!(ssss)) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b ssss) :: @NatValue unit stack_var_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem14 : forall s n b, id -> nat -> realizeState + (AbsUpdateLoc + (AbsUpdateVar + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(ssss) ==== v(0)] ** + AbsExistsT + (AbsUpdateLoc + ([~~ v(5)] ** + AbsUpdateWithLoc + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + ssss)))))) + ssss !!(assignments) ++++ !!(varx)) + !!(assignments) ++++ !!(varx) + !!(valuex)))))))) + !!(ssss) ++++ #next_offset !!(stack)) + stack !!(ssss)) !!(ssss) ++++ #stack_var_offset + !!(varx)) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b ssss) :: @NatValue unit stack_val_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem15 : forall s n b, id -> nat -> realizeState + (AbsUpdateLoc + (AbsUpdateLoc + (AbsUpdateVar + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(ssss) ==== v(0)] ** + AbsExistsT + (AbsUpdateLoc + ([~~ v(5)] ** + AbsUpdateWithLoc + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + ssss)))))) + ssss + !!(assignments) ++++ !!(varx)) + !!(assignments) ++++ !!(varx) + !!(valuex)))))))) + !!(ssss) ++++ #next_offset !!(stack)) + stack !!(ssss)) !!(ssss) ++++ #stack_var_offset + !!(varx)) !!(ssss) ++++ #stack_val_offset + !!(valuex)) nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b ssss) :: @NatValue unit stack_prop_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem6 : mergeStates + (AbsUpdateVar + ([!!(ssss) //\\ !!(vvvv) ==== #2] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar ([~~ #3 <<<< !!(jjjj)] ** invariantWLIT1) + jjjj !!(jjjj) ++++ #1) ssss + (!!(clause) ++++ #positive_lit_offset) ++++ !!(jjjj)) + vvvv !!(assignments) ++++ !!(jjjj)) skip + #1) + ([~~ (!!(ssss) //\\ !!(vvvv) ==== #2)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateVar ([~~ #3 <<<< !!(jjjj)] ** invariantWLIT1) + jjjj !!(jjjj) ++++ #1) ssss + (!!(clause) ++++ #positive_lit_offset) ++++ !!(jjjj)) + vvvv !!(assignments) ++++ !!(jjjj)) invariantWLIT1. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem7 : mergeStates + (AbsUpdateVar + ([!!(ssss) //\\ !!(vvvv) ==== #1] ** + AbsUpdateWithLoc invariantWLIT1 ssss + (!!(clause) ++++ #negative_lit_offset) ++++ !!(jjjj)) + skip #1) + ([~~ (!!(ssss) //\\ !!(vvvv) ==== #1)] ** + AbsUpdateWithLoc invariantWLIT1 ssss + (!!(clause) ++++ #negative_lit_offset) ++++ !!(jjjj)) invariantWLIT1. +Proof. + + + admit. +Admitted. + + +Theorem mergeTheorem8 : mergeStates + (AbsUpdateVar + (AbsUpdateVar + ([!!(vvvv) //\\ !!(ssss) ==== #0] ** + AbsUpdateWithLoc invariantWLIT1 ssss + (!!(clause) ++++ #watch_var_offset) ++++ !!(jjjj)) + non_watch !!(jjjj)) skip #1) + ([~~ (!!(vvvv) //\\ !!(ssss) ==== #0)] ** + AbsUpdateWithLoc invariantWLIT1 ssss + (!!(clause) ++++ #watch_var_offset) ++++ !!(jjjj)) invariantWLIT1. +Proof. + + + admit. +Admitted. + + +Theorem entailment7 : forall x0 : state, + realizeState + (AbsUpdateVar + (AbsUpdateVar + (AbsUpdateVar + ([!!(valuex) ==== #2 //\\ !!(ssss) \\// + !!(valuex) ==== #1 //\\ !!(vvvv)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc ([!!(clause)] ** invariantWL) + nc (!!(clause) ++++ #watch_next_offset) ++++ !!(varx)) + ssss (!!(clause) ++++ #negative_lit_offset) ++++ !!(varx)) + vvvv (!!(clause) ++++ #positive_lit_offset) ++++ !!(varx)) + skip #0) skip #0) jjjj #0) nil x0 -> + realizeState invariantWLIT1 nil x0. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem16 : forall s n b, id -> nat -> realizeState + (AbsUpdateWithLoc + ([!!(skip)] ** + [~~ !!(skip)] ** + [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1) + ssss !!(watches) ++++ !!(non_watch)) nil s -> NatValue n = + basicEval assignments_to_do_head + (basicEval assignments_to_do_head + (NatValue (b clause) :: NatValue watch_next_offset :: nil) + :: @NatValue unit (b non_watch) :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem17 : forall s n b, id -> nat -> realizeState + (AbsUpdateLoc + (AbsUpdateWithLoc + ([!!(skip)] ** + [~~ !!(skip)] ** + [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1) + ssss !!(watches) ++++ !!(non_watch)) + (!!(clause) ++++ #watch_next_offset) ++++ !!(non_watch) + !!(ssss)) nil s -> NatValue n = + basicEval assignments_to_do_head + (basicEval assignments_to_do_head + (NatValue (b clause) :: NatValue watch_var_offset :: nil) + :: @NatValue unit (b non_watch) :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem18 : forall s n b, id -> nat -> realizeState + ([!!(ssss)] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsUpdateWithLoc + ([!!(skip)] ** + [~~ !!(skip)] ** + [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1) + ssss !!(watches) ++++ !!(non_watch)) + (!!(clause) ++++ #watch_next_offset) ++++ !!(non_watch) + !!(ssss)) + (!!(clause) ++++ #watch_var_offset) ++++ !!(non_watch) + #1) nil s -> NatValue n = + basicEval assignments_to_do_head + (basicEval assignments_to_do_head + (NatValue (b ssss) :: NatValue watch_prev_offset :: nil) + :: @NatValue unit (b non_watch) :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem9 : mergeStates + (AbsUpdateLoc + ([!!(ssss)] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsUpdateWithLoc + ([!!(skip)] ** + [~~ !!(skip)] ** + [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1) + ssss !!(watches) ++++ !!(non_watch)) + (!!(clause) ++++ #watch_next_offset) ++++ !!(non_watch) + !!(ssss)) + (!!(clause) ++++ #watch_var_offset) ++++ !!(non_watch) + #1) (!!(ssss) ++++ #watch_prev_offset) ++++ !!(non_watch) + !!(clause)) + ([~~ !!(ssss)] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsUpdateWithLoc + ([!!(skip)] ** + [~~ !!(skip)] ** + [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1) + ssss !!(watches) ++++ !!(non_watch)) + (!!(clause) ++++ #watch_next_offset) ++++ !!(non_watch) + !!(ssss)) (!!(clause) ++++ #watch_var_offset) ++++ !!(non_watch) + #1) invariantWLIT1. +Proof. + + + admit. +Admitted. + + +Theorem validRefTheorem19 : forall s n b, id -> nat -> realizeState invariantWLIT1 nil s -> NatValue n = + basicEval assignments_to_do_head + (NatValue (b watches) :: @NatValue unit (b non_watch) :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem20 : forall s n b, id -> nat -> realizeState + (AbsUpdateLoc invariantWLIT1 !!(watches) ++++ !!(non_watch) + !!(clause)) nil s -> NatValue n = + basicEval assignments_to_do_head + (basicEval assignments_to_do_head + (NatValue (b clause) :: NatValue watch_var_offset :: nil) + :: @NatValue unit (b varx) :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem21 : forall s n b, id -> nat -> realizeState + ([!!(ssss)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateLoc + (AbsUpdateLoc invariantWLIT1 !!(watches) ++++ !!(non_watch) + !!(clause)) + (!!(clause) ++++ #watch_var_offset) ++++ !!(varx) + #0) ssss (!!(clause) ++++ #watch_prev_offset) ++++ !!(varx)) + vvvv (!!(clause) ++++ #watch_next_offset) ++++ !!(varx)) nil s -> NatValue n = + basicEval assignments_to_do_head + (basicEval assignments_to_do_head + (NatValue (b ssss) :: NatValue watch_next_offset :: nil) + :: @NatValue unit (b varx) :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem22 : forall s n b, id -> nat -> realizeState + ([~~ !!(ssss)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateLoc + (AbsUpdateLoc invariantWLIT1 !!(watches) ++++ !!(non_watch) + !!(clause)) + (!!(clause) ++++ #watch_var_offset) ++++ !!(varx) + #0) ssss (!!(clause) ++++ #watch_prev_offset) ++++ !!(varx)) + vvvv (!!(clause) ++++ #watch_next_offset) ++++ !!(varx)) nil s -> NatValue n = + basicEval assignments_to_do_head + (@NatValue unit (b watches) :: NatValue (b varx) :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem10 : mergeStates + (AbsUpdateLoc + ([!!(ssss)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateLoc + (AbsUpdateLoc invariantWLIT1 !!(watches) ++++ !!(non_watch) + !!(clause)) + (!!(clause) ++++ #watch_var_offset) ++++ !!(varx) + #0) ssss (!!(clause) ++++ #watch_prev_offset) ++++ !!(varx)) + vvvv (!!(clause) ++++ #watch_next_offset) ++++ !!(varx)) + (!!(ssss) ++++ #watch_next_offset) ++++ !!(varx) + !!(vvvv)) + (AbsUpdateLoc + ([~~ !!(ssss)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateLoc + (AbsUpdateLoc invariantWLIT1 !!(watches) ++++ !!(non_watch) + !!(clause)) + (!!(clause) ++++ #watch_var_offset) ++++ !!(varx) + #0) ssss (!!(clause) ++++ #watch_prev_offset) ++++ !!(varx)) + vvvv (!!(clause) ++++ #watch_next_offset) ++++ !!(varx)) + !!(watches) ++++ !!(varx) !!(vvvv)) invariantWLIT1. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem23 : forall s n b, id -> nat -> realizeState ([!!(vvvv)] ** invariantWLIT1) nil s -> NatValue n = + basicEval assignments_to_do_head + (basicEval assignments_to_do_head + (NatValue (b vvvv) :: NatValue watch_prev_offset :: nil) + :: @NatValue unit (b varx) :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem11 : mergeStates + (AbsUpdateLoc ([!!(vvvv)] ** invariantWLIT1) + (!!(vvvv) ++++ #watch_prev_offset) ++++ !!(varx) + !!(ssss)) ([~~ !!(vvvv)] ** invariantWLIT1) invariantWLIT1. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem12 : mergeStates + (AbsUpdateVar + ([!!(ssss)] ** + AbsUpdateWithLoc + (AbsUpdateVar + ([!!(ssss) //\\ !!(jjjj) ==== #0] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc ([~~ #3 <<<< !!(kkkk)] ** invariantWLIT2) + ssss (!!(clause) ++++ #watch_var_offset) ++++ !!(kkkk)) + jjjj !!(assignments) ++++ !!(kkkk)) + vvvv !!(kkkk)) ssss + (!!(clause) ++++ #positive_lit_offset) ++++ !!(vvvv)) + val #2) + ([~~ !!(ssss)] ** + AbsUpdateWithLoc + (AbsUpdateVar + ([!!(ssss) //\\ !!(jjjj) ==== #0] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc ([~~ #3 <<<< !!(kkkk)] ** invariantWLIT2) + ssss (!!(clause) ++++ #watch_var_offset) ++++ !!(kkkk)) + jjjj !!(assignments) ++++ !!(kkkk)) vvvv + !!(kkkk)) ssss + (!!(clause) ++++ #positive_lit_offset) ++++ !!(vvvv)) invariantWLIT2. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem13 : mergeStates + (AbsUpdateVar + ([!!(ssss)] ** + AbsUpdateWithLoc invariantWLIT2 ssss + (!!(clause) ++++ #negative_lit_offset) ++++ !!(vvvv)) + val #1) + ([~~ !!(ssss)] ** + AbsUpdateWithLoc invariantWLIT2 ssss + (!!(clause) ++++ #negative_lit_offset) ++++ !!(vvvv)) invariantWLIT2. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem14 : mergeStates invariantWLIT2 + ([~~ (!!(ssss) //\\ !!(jjjj) ==== #0)] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc ([~~ #3 <<<< !!(kkkk)] ** invariantWLIT2) + ssss (!!(clause) ++++ #watch_var_offset) ++++ !!(kkkk)) + jjjj !!(assignments) ++++ !!(kkkk)) invariantWLIT2. +Proof. + admit. +Admitted. + + +Theorem entailment8 : forall s : state, + realizeState (AbsUpdateVar invariantWLIT2 kkkk !!(kkkk) ++++ #1) nil s -> + realizeState invariantWLIT2 nil s. +Proof. + admit. +Admitted. + + +Theorem entailment9 : forall x0 : state, + realizeState + (AbsUpdateVar + ([~~ !!(skip)] ** + [~~ !!(skip)] ** + [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1) + kkkk #0) nil x0 -> realizeState invariantWLIT2 nil x0. +Proof. + + + admit. +Admitted. + + +Theorem validRefTheorem24 : forall s n b, id -> nat -> realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + ([ + ~~ + (convertToAbsExp + (!(kkkk) <<= A3))] ** + invariantWLIT2) + todo)))))))))))))) nil s -> NatValue n = + basicEval assignments_to_do_head + (@NatValue unit (b todo) :: NatValue next_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem25 : forall s n b, id -> nat -> realizeState + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + ([ + ~~ (convertToAbsExp (!(kkkk) <<= A3))] ** + invariantWLIT2) + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) nil s -> NatValue n = + basicEval assignments_to_do_head + (@NatValue unit (b todo) :: NatValue prev_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem26 : forall s n b, id -> nat -> realizeState + ([!!(assignments_to_do_tail)] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + ([~~ (convertToAbsExp (!(kkkk) <<= A3))] ** invariantWLIT2) + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) + !!(todo) ++++ #prev_offset #0) nil s -> NatValue n = + basicEval assignments_to_do_head + (@NatValue unit (b assignments_to_do_head) :: NatValue prev_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem15 : mergeStates + (AbsUpdateLoc + ([!!(assignments_to_do_tail)] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + ([~~ (convertToAbsExp (!(kkkk) <<= A3))] ** invariantWLIT2) + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) + !!(todo) ++++ #prev_offset #0) + !!(assignments_to_do_head) ++++ #prev_offset + !!(todo)) + (AbsUpdateVar + ([~~ !!(assignments_to_do_tail)] ** + AbsUpdateLoc + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #4 |-> v(5) ** + v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(todo) ==== v(0)] ** + AbsExistsT + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + ([~~ (convertToAbsExp (!(kkkk) <<= A3))] ** invariantWLIT2) + todo)))))))))))))) + !!(todo) ++++ #next_offset !!(assignments_to_do_head)) + !!(todo) ++++ #prev_offset #0) assignments_to_do_tail + !!(todo)) invariantWLIT2. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem27 : forall s n b, id -> nat -> realizeState + (AbsUpdateVar invariantWLIT2 assignments_to_do_head !!(todo)) nil s -> NatValue n = + basicEval assignments_to_do_head + (@NatValue unit (b todo) :: NatValue todo_var_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem28 : forall s n b, id -> nat -> realizeState + (AbsUpdateLoc + (AbsUpdateVar invariantWLIT2 assignments_to_do_head !!(todo)) + !!(todo) ++++ #todo_var_offset !!(vvvv)) nil s -> NatValue n = + basicEval assignments_to_do_head + (@NatValue unit (b todo) :: NatValue todo_val_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem validRefTheorem29 : forall s n b, id -> nat -> realizeState + (AbsUpdateLoc + (AbsUpdateLoc + (AbsUpdateVar invariantWLIT2 assignments_to_do_head !!(todo)) + !!(todo) ++++ #todo_var_offset !!(vvvv)) + !!(todo) ++++ #todo_val_offset !!(val)) nil s -> NatValue n = + basicEval assignments_to_do_head + (@NatValue unit (b todo) :: NatValue todo_unit_offset :: nil) -> heap_p s n <> None. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem16 : mergeStates invariantWLIT1 + (AbsUpdateLoc + (AbsUpdateLoc + (AbsUpdateLoc + (AbsUpdateVar invariantWLIT2 assignments_to_do_head !!(todo)) + !!(todo) ++++ #todo_var_offset !!(vvvv)) + !!(todo) ++++ #todo_val_offset !!(val)) + !!(todo) ++++ #todo_unit_offset #1) invariantWLIT1. +Proof. + admit. +Admitted. + + +Theorem mergeTheorem17 : mergeStates + ([!!(skip)] ** [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1) + invariantWLIT1 invariantWLIT1. +Proof. + admit. +Admitted. + + +Theorem mergeReturn3 : mergeReturnStates invariant invariant invariant + (#0 :: #1 :: nil) (#0 :: #1 :: nil) (#0 :: #1 :: nil). +Proof. + admit. +Admitted. + +Theorem mergeTheorem18 : mergeStates invariantWLIT1 + ([~~ + (!!(valuex) ==== #2 //\\ !!(ssss) \\// + !!(valuex) ==== #1 //\\ !!(vvvv))] ** + AbsUpdateWithLoc + (AbsUpdateWithLoc + (AbsUpdateWithLoc ([!!(clause)] ** invariantWL) + nc (!!(clause) ++++ #watch_next_offset) ++++ !!(varx)) + ssss (!!(clause) ++++ #negative_lit_offset) ++++ !!(varx)) + vvvv (!!(clause) ++++ #positive_lit_offset) ++++ !!(varx)) + invariantWL. +Proof. + admit. +Admitted. + + +Theorem entailment10 : forall s : state, + realizeState (AbsUpdateVar invariantWL clause !!(nc)) nil s -> + realizeState invariantWL nil s. +Proof. + admit. +Admitted. + + +Theorem equivEvalList1 : forall s : state, + realizeState invariant nil s -> + realizeState invariant nil s -> + equivEvalList (fst s) (#0 :: #1 :: nil) (#0 :: #1 :: nil). +Proof. + admit. +Admitted. + +Set Printing Depth 1000. + + +Theorem entailment11 : forall x0 : state, + realizeState + (AbsUpdateWithLoc + (AbsUpdateLoc + (AbsUpdateLoc + (AbsUpdateLoc + (AbsUpdateVar + (AbsUpdateLoc + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v(0) ++++ #3 |-> v(4) ** + v(0) ++++ #2 |-> v(3) ** + v(0) ++++ #1 |-> v(2) ** + v(0) ++++ #0 |-> v(1) ** + [!!(ssss) ==== v(0)] ** + AbsExistsT + (AbsUpdateLoc + ([~~ v(5)] ** + AbsUpdateWithLoc + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (pushAbsVarState + (quantifyAbsVarState + invariant + ssss)))))) + ssss + !!(assignments) ++++ !!(varx)) + !!(assignments) ++++ !!(varx) + !!(valuex)))))))) + !!(ssss) ++++ #next_offset !!(stack)) + stack !!(ssss)) !!(ssss) ++++ #stack_var_offset + !!(varx)) !!(ssss) ++++ #stack_val_offset + !!(valuex)) !!(ssss) ++++ #stack_prop_offset + !!(prop)) clause !!(watches) ++++ !!(varx)) nil x0 -> + realizeState invariantWL nil x0. +Proof. + + + + admit. +Admitted. + + +Theorem mergeReturn4 : mergeReturnStates invariant invariant invariant + (#0 :: #1 :: nil) (#0 :: #1 :: nil) (#0 :: #1 :: nil). +Proof. + admit. +Admitted. + + +Theorem mergeTheorem19 : mergeStates invariant ([~~ (convertToAbsExp (!clause))] ** invariantWL) + invariant. +Proof. + admit. +Admitted. + + +Theorem entailment12 : forall x0 : state, + realizeState + (AbsUpdateLoc + (AbsUpdateLoc + (AbsUpdateLoc + (AbsUpdateVar invariant assignments_to_do_head !!(todo)) + !!(todo) ++++ #todo_var_offset !!(varx)) + !!(todo) ++++ #todo_val_offset !!(valuex)) + !!(todo) ++++ #todo_unit_offset #0) nil x0 -> + realizeState invariant nil x0. +Proof. + admit. +Admitted. + + +Theorem mergeReturn5 : mergeReturnStates ([!!(have_var) ==== #0] ** invariant) invariant + invariant (#1 :: nil) (#0 :: #1 :: nil) (#0 :: #1 :: nil). +Proof. + admit. +Admitted. + + +Theorem mergeReturn6 : mergeReturnStates invariant invariant invariant + (#0 :: #1 :: nil) (#0 :: #1 :: nil) (#0 :: #1 :: nil). +Proof. + admit. +Admitted. + + +Theorem entailment13 : forall s : state, + realizeState + ([~~ (convertToAbsExp (!assignments_to_do_tail))] ** invariant) nil s -> + realizeState invariant nil s. +Proof. + admit. +Admitted. + + +Theorem entailment14 : forall x0 : state, + realizeState (AbsUpdateVar invariant backtrack #0) nil x0 -> + realizeState invariant nil x0. +Proof. + admit. +Admitted. + + +Theorem mergeReturn7 : mergeReturnStates AbsNone invariant invariant (#0 :: nil) + (#0 :: #1 :: nil) (#0 :: #1 :: nil). +Proof. + admit. +Admitted. + + +Theorem entailment15 : forall s : state, + realizeState ([~~ (convertToAbsExp A1)] ** invariant) nil s -> + realizeState (finalState 0) nil s. +Proof. + admit. +Admitted. + + +Theorem entailment16 : forall s : state, + realizeState invariant nil s -> realizeState (finalState 0) nil s. +Proof. + admit. +Admitted. + + + + Theorem SatProgramWorks : - exists x, {{invariant}}Program{{(finalState x),(Return x)}}. + exists x, {{(AbsClosure invariant ((!!clauses)::(!!assignments_to_do_head)::(!!stack)::(!!assignments)::(!!watches)::nil))}}Program{{(finalState x) return (#0::#1::nil) with (finalState x)}}. Proof. unfold Program. eapply ex_intro. + eapply strengthenPost. + eapply compose. + pcrunch. + eapply while with (invariant := loopInvariant). eapply sbasic. + instantiate ( 1:= invariant). + + eapply strengthenPost. + pcrunch. +eapply preCond1. apply H0. + + + eapply preCond2. apply (fun x => 0). apply H. apply H0. + + eapply while with (invariant := haveVarInvariant). eapply sbasic. + instantiate ( 1 := invariant ). + + eapply strengthenPost. + pcrunch. + apply mergeTheorem1. + apply entailment1. + + intros. inversion H. intros. inversion H. + + apply entailment2. apply (fun x => 0, fun x => None). + instantiate (1 := invariant). + apply mergeTheorem2. + eapply validRefTheorem1. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem2. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem3. apply (Id 0). apply n. apply H. apply H0. + instantiate (1 := invariant). + apply mergeTheorem3. + + (*eapply validRefTheorem4. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem5. apply (Id 0). apply n. apply H. apply H0. + admit. -Qed. + + eapply while with (invariant :=invariant). eapply sbasic. + instantiate (1 := invariant). instantiate (1 := (#0::#1::nil)). + eapply strengthenPost. pcrunch. + + + + eapply validRefTheorem7. apply (Id 0). apply n. apply H. apply H0. + + apply existsTheorem1. + apply existsTheorem2. + + instantiate (1 := invariant). + apply mergeTheorem4. + + eapply while with (invariant := invariantNoTail). eapply sbasic. + eapply strengthenPost. pcrunch. + eapply existsTheorem3. + apply entailment3. + + intros. inversion H. intros. inversion H. + apply entailment4. + + pcrunch. + + eapply while with (invariant := invariant). eapply sbasic. + eapply strengthenPost. pcrunch. + + + eapply validRefTheorem8. apply (Id 0). apply n. apply H. apply H0. + apply existsTheorem4. + apply entailment5. + + intros. inversion H. + intros. inversion H. + apply entailment6. + eapply validRefTheorem9. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem10. apply (Id 0). apply n. apply H. apply H0. + + instantiate (1 := (#0::#1::nil)). instantiate (1 := (#0::#1::nil)). + instantiate (1 := invariant). instantiate (1 := invariant). + apply mergeReturn1. + + instantiate (1 := (#0::#1::nil)). instantiate (1 := (#0::#1::nil)). + instantiate (1 := invariant). instantiate (1 := invariant). + apply mergeReturn2. + + instantiate (1 := invariant). + apply mergeTheorem5. + eapply validRefTheorem11. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem12. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem13. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem14. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem15. apply (Id 0). apply n. apply H. apply H0. + + eapply while with (invariant := invariantWL). eapply sbasic. + eapply strengthenPost. pcrunch. + + eapply while with (invariant := invariantWLIT1). eapply sbasic. + eapply strengthenPost. pcrunch. + + instantiate (1 := invariantWLIT1). + apply mergeTheorem6. + + instantiate (1 := invariantWLIT1). + apply mergeTheorem7. + + instantiate (1 := invariantWLIT1). + apply mergeTheorem8. + + intros. apply H. + + intros. inversion H. + intros. inversion H. + + apply entailment7. + eapply validRefTheorem16. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem17. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem18. apply (Id 0). apply n. apply H. apply H0. + + instantiate (1 := invariantWLIT1). + apply mergeTheorem9. + + eapply validRefTheorem19. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem20. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem21. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem22. apply (Id 0). apply n. apply H. apply H0. + + instantiate (1 := invariantWLIT1). + apply mergeTheorem10. + + eapply validRefTheorem23. apply (Id 0). apply n. apply H. apply H0. + + instantiate (1 := invariantWLIT1). + apply mergeTheorem11. + + eapply while with (invariant := invariantWLIT2). eapply sbasic. + eapply strengthenPost. pcrunch. + + instantiate (1 := invariantWLIT2). + apply mergeTheorem12. + + instantiate (1 := invariantWLIT2). + apply mergeTheorem13. + + instantiate (1 := invariantWLIT2). + apply mergeTheorem14. + + apply entailment8. + + + intros. inversion H. + intros. inversion H. + + apply entailment9. + + eapply validRefTheorem24. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem25. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem26. apply (Id 0). apply n. apply H. apply H0. + + instantiate (1 := invariantWLIT2). + apply mergeTheorem15. + + eapply validRefTheorem27. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem28. apply (Id 0). apply n. apply H. apply H0. + eapply validRefTheorem29. apply (Id 0). apply n. apply H. apply H0. + + instantiate (1 := invariantWLIT1). + apply mergeTheorem16. + + instantiate (1 := invariantWLIT1). + apply mergeTheorem17. + + instantiate (1 := (#0)::(#1)::nil). + instantiate (1 := (#0)::(#1)::nil). + instantiate (1 := (#0)::(#1)::nil). + instantiate (1 := invariant). + instantiate (1 := invariant). + instantiate (1 := invariant). + apply mergeReturn3. + + instantiate (1 := invariantWL). + apply mergeTheorem18. + + apply entailment10. + + intros. apply H. + instantiate (1 := (#0::#1::nil)). + apply equivEvalList1. + + apply entailment11. + + instantiate (1 := (#0)::(#1)::nil). + instantiate (1 := invariant). + apply mergeReturn4. + instantiate (1 := invariant). + apply mergeTheorem19. + + intros. apply H. + intros. apply H. + + apply equivEvalList1. + + apply entailment12. + + instantiate (1 := (#0)::(#1)::nil). instantiate (1 := invariant). + apply mergeReturn5. + + instantiate (1 := (#0)::(#1)::nil). + instantiate (1 := (#0)::(#1)::nil). + instantiate (1 := invariant). + apply mergeReturn6. + + apply entailment13. + + intros. apply H. + + apply equivEvalList1. + + apply entailment14. + + instantiate (1 := (#0)::(#1)::nil). + instantiate (1 := invariant). + apply mergeReturn7. instantiate (1 := 0). + + apply entailment15. + apply entailment16. + intros. apply equivEvalList1. apply H. apply H. + + Grab Existential Variables. + + apply (nil). + apply (nil). + apply (nil). + apply (nil). + apply (nil). + apply (nil). + apply (nil). + apply (nil). + apply (nil). + apply (nil). + apply (nil). + apply (nil). + apply (nil). + apply (nil). + apply (nil).*) + + admit. +Admitted. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/SatSolverMergeTheorem1P1.v b/PEDANTIC/SatSolverMergeTheorem1P1.v new file mode 100644 index 0000000..eddc2ee --- /dev/null +++ b/PEDANTIC/SatSolverMergeTheorem1P1.v @@ -0,0 +1,1590 @@ +(********************************************************************************** + * The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic + * Traversal of Instruction Code) verification framework + * + * Developed by Kenneth Roe + * For more information, check out www.cs.jhu.edu/~roe + * + * TreeTraversal.v + * This file contains the proof of correctness of a tree traversal algorithm using + * the PEDANTIC verification framework. + * + **********************************************************************************) + +Require Export SfLib. +Require Export SfLibExtras. +Require Export ImpHeap. +Require Export AbsState. +Require Export AbsExecute. +Require Export AbsStateInstance. +Require Export Simplify. +Require Export Eqdep. +Require Export StateImplication. +Require Export Classical. +Require Export Unfold. +Require Export Fold. +Require Export merge. +Require Export ProgramTactics. +Require Export SatSolverDefs. +Opaque basicEval. + +Set Printing Depth 200. + +Theorem mergeTheorem1Aux8 : forall eee v v0 v1 v2 l v4 x x0 e n, + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )---> (#2 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #2] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #1] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(#0, #4), #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8)), + #2)) (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + (forall x1 : Value, + NatValue 0 = x1 \/ + NatValue 1 = x1 \/ NatValue 2 = x1 \/ NatValue 3 = x1 \/ False -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8))]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: nil) + (eee, empty_heap)) -> + In x0 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + NatValue 0 = nth (eee varx) l NoValue -> + e <> 0 -> + NatValue e = + (if match eee varx with + | 0 => false + | 1 => false + | 2 => false + | 3 => false + | S (S (S (S _))) => true + end + then NatValue 0 + else @NatValue unit 1) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsExists range(#0, #4) + (([--( v(2), v(6) )---> (#2 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #2] *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #1]) ** + AbsAll range(#0, #4) + (([#0 ==== nth(replacenth(v(4), !!(varx), !!(valuex)), v(9))] *\/* + [--( v(2), v(6) )---> (#10 ++++ v(9)) ==== #0] ** + [#0 <<<< nth(replacenth(v(4), !!(varx), !!(valuex)), v(9))]) *\/* + ([!!(varx) ==== v(9)] ** + ([#0 <<<< --( v(2), v(6) )---> (#2 ++++ !!(varx))] ** + [!!(valuex) ==== #2] *\/* + [#0 <<<< --( v(2), v(6) )---> (#6 ++++ !!(varx))] ** + [!!(valuex) ==== #1]) *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + ([#0 <<<< + --( v(2), v(6) + )---> (#2 ++++ nth(find(v(0), v(10)), #3))] ** + [nth(find(v(0), v(10)), #4) ==== #2] *\/* + [#0 <<<< + --( v(2), v(6) + )---> (#6 ++++ nth(find(v(0), v(10)), #3))] ** + [nth(find(v(0), v(10)), #4) ==== #1]))) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + ([#0 <<<< + --( v(2), v(6) + )---> (#2 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #2] *\/* + [#0 <<<< + --( v(2), v(6) + )---> (#6 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #1])))))) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + (S n = @mapSum unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (@NatValue unit 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) + (--( v(2), v(6) )---> (#2 ++++ v(8)) //\\ nth(v(4), v(8)) ==== #2 \\// + --( v(2), v(6) )---> (#6 ++++ v(8)) //\\ nth(v(4), v(8)) ==== #1)) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsExists range(#0, #4) + (([--( v(2), v(6) )---> (#2 ++++ v(8))] ** [nth(v(4), v(8)) ==== #2] *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))] ** [nth(v(4), v(8)) ==== #1]) ** + AbsAll range(#0, #4) + (([#0 ==== nth(v(4), v(9))] *\/* + [--( v(2), v(6) )---> (#10 ++++ v(9)) ==== #0] ** + [#0 <<<< nth(v(4), v(9))]) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + ([#0 <<<< + --( v(2), v(6) )---> (#2 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #2] *\/* + [#0 <<<< + --( v(2), v(6) )---> (#6 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #1])))))) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap). +Proof. + intros. + + inversion H6. subst. clear H6. inversion H15. subst. clear H15. inversion H6. subst. clear H6. + Transparent basicEval. simpl in H12. Opaque basicEval. inversion H12. subst. clear H12. + + inversion H10. subst. clear H10. + eapply concreteComposeEmpty in H16. inversion H16. subst. clear H16. + simpl in H12. simpl in H13. + inversion H13. subst. clear H13. + Transparent basicEval. simpl in H14. Opaque basicEval. inversion H14. subst. clear H14. + + eapply mapSumExists in H7. + inversion H7. subst. clear H7. + inversion H6. subst. clear H6. + simplifyHyp H10. simplifyHyp H10. + + eapply RSExists. Transparent basicEval. simpl. Opaque basicEval. reflexivity. reflexivity. + eapply ex_intro. split. apply H7. + + eapply RSCompose. + Focus 3. eapply concreteComposeEmpty. split. reflexivity. reflexivity. + + simpl. apply H10. + + simpl in H17. + + eapply RSAll. Transparent basicEval. simpl. Opaque basicEval. reflexivity. reflexivity. + intros. simpl. apply H17 in H6. + + destruct x3; hypSimp. + remember (beq_nat n0 (eee varx)). + destruct b. + + eapply RSOrComposeL. eapply RSOrComposeL. + eapply RSR. Transparent basicEval. simpl. Opaque basicEval. + apply beq_nat_eq in Heqb. subst. + rewrite <- H3. reflexivity. + + apply BTStatePredicate. omega. unfold empty_heap. reflexivity. + + eapply removeReplace in H6. Focus 2. instantiate (1 := !!varx). instantiate (1 := v(9)). + instantiate (1 := (v + :: v0 + :: v1 + :: v2 + :: ListValue l + :: v4 :: x :: x0 :: x1 :: NatValue n0 :: nil)). instantiate (1 := eee). + Transparent basicEval. simpl. rewrite <- Heqb. simpl. reflexivity. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. reflexivity. Focus 2. simpl. reflexivity. + + inversion H6. subst. clear H6. + eapply RSOrComposeL. + eapply dumpVar in H16. Focus 2. instantiate (1 := 8). simpl. reflexivity. + Focus 2. simpl. reflexivity. simpl in H16. + eapply dumpVar2. Focus 2. instantiate (1 := 8). simpl. reflexivity. + Focus 2. simpl. reflexivity. simpl. + apply H16. + + subst. clear H6. + inversion H16. subst. clear H16. + inversion H15. subst. clear H15. + inversion H16. subst. clear H16. + apply concreteComposeEmpty in H19. inversion H19. subst. clear H19. + apply RSOrComposeL. apply RSOrComposeL. + + inversion H13. subst. clear H13. + Transparent basicEval. simpl in H19. Opaque basicEval. + remember (beq_nat (eee varx) n0). destruct b. apply beq_nat_eq in Heqb0. subst. + rewrite <- beq_nat_refl in Heqb. inversion Heqb. + inversion H19. elim H11. reflexivity. + subst. + inversion H16. subst. clear H16. + inversion H20. subst. clear H20. + inversion H6. subst. clear H6. + inversion H13. subst. clear H13. + eapply concreteComposeEmpty in H22. inversion H22. subst. clear H22. + inversion H18. subst. clear H18. + Transparent basicEval. simpl in H22. Opaque basicEval. + remember (beq_nat (eee varx) n0). + destruct b. eapply beq_nat_eq in Heqb0. subst. rewrite <- beq_nat_refl in Heqb. inversion Heqb. + inversion H22. subst. clear H22. elim H13. reflexivity. + + subst. eapply RSOrComposeR. + eapply dumpVar in H15. Focus 2. instantiate (1 := 8). simpl. reflexivity. + Focus 2. simpl. reflexivity. simpl in H15. + eapply dumpVar2. Focus 2. instantiate (1 := 8). simpl. reflexivity. + Focus 2. simpl. reflexivity. simpl. + apply H15. + + inversion H6. subst. clear H6. + inversion H16. subst. clear H16. + inversion H15. subst. clear H15. + Transparent basicEval. simpl in H18. Opaque basicEval. inversion H18. + subst. clear H16. + inversion H15. subst. clear H15. + eapply concreteComposeEmpty in H19. inversion H19. subst. clear H19. + inversion H13. subst. clear H13. + Transparent basicEval. simpl in H19. Opaque basicEval. + destruct x; inversion H19. + destruct (findRecord n0 v1); inversion H6. + subst. clear H6. + inversion H16. subst. clear H16. + inversion H15. subst. clear H15. + inversion H16. subst. clear H16. + eapply concreteComposeEmpty in H19. inversion H19. subst. clear H19. + inversion H13. subst. clear H13. + Transparent basicEval. simpl in H19. Opaque basicEval. + inversion H19. + subst. clear H15. + inversion H16. subst. clear H16. + Transparent basicEval. simpl in H14. + inversion H19. subst. clear H19. inversion H6. subst. clear H6. + inversion H13. subst. clear H13. + eapply concreteComposeEmpty in H21. inversion H21. subst. clear H21. + inversion H16. subst. clear H16. + Transparent basicEval. simpl in H21. Opaque basicEval. + inversion H21. + subst. clear H16. + inversion H15. subst. clear H15. + inversion H19. subst. clear H19. + inversion H6. subst. clear H6. + inversion H13. subst. clear H13. + inversion H21. subst. clear H21. + inversion H6. subst. clear H6. + inversion H15. subst. clear H15. + eapply concreteComposeEmpty in H23. inversion H23. subst. clear H23. + inversion H19. subst. clear H19. + Transparent basicEval. simpl in H23. + destruct x3; inversion H23. + destruct (findRecord n0 v); inversion H6. + destruct (nth 3 l1 NoValue); inversion H22. + + inversion H6. subst. clear H6. + inversion H16. subst. clear H16. + inversion H15. subst. clear H15. + Transparent basicEval. simpl in H18. Opaque basicEval. inversion H18. + subst. clear H16. + inversion H15. subst. clear H15. + eapply concreteComposeEmpty in H19. inversion H19. subst. clear H19. + inversion H13. subst. clear H13. + Transparent basicEval. simpl in H19. Opaque basicEval. + destruct x; inversion H19. + destruct (findRecord n0 v1); inversion H6. + subst. clear H6. + inversion H16. subst. clear H16. + inversion H15. subst. clear H15. + inversion H16. subst. clear H16. + eapply concreteComposeEmpty in H19. inversion H19. subst. clear H19. + inversion H13. subst. clear H13. + Transparent basicEval. simpl in H19. Opaque basicEval. + inversion H19. + subst. clear H15. + inversion H16. subst. clear H16. + Transparent basicEval. simpl in H14. + inversion H19. subst. clear H19. inversion H6. subst. clear H6. + inversion H13. subst. clear H13. + eapply concreteComposeEmpty in H21. inversion H21. subst. clear H21. + inversion H16. subst. clear H16. + Transparent basicEval. simpl in H21. Opaque basicEval. + inversion H21. + subst. clear H16. + inversion H15. subst. clear H15. + inversion H19. subst. clear H19. + inversion H6. subst. clear H6. + inversion H13. subst. clear H13. + inversion H21. subst. clear H21. + inversion H6. subst. clear H6. + inversion H15. subst. clear H15. + eapply concreteComposeEmpty in H23. inversion H23. subst. clear H23. + inversion H19. subst. clear H19. + Transparent basicEval. simpl in H23. + destruct x3; inversion H23. + destruct (findRecord n0 v); inversion H6. + destruct (nth 3 l0 NoValue); inversion H22. + + inversion H6. subst. clear H6. + inversion H16. subst. clear H16. + inversion H15. subst. clear H15. + Transparent basicEval. simpl in H18. Opaque basicEval. inversion H18. + subst. clear H16. + inversion H15. subst. clear H15. + eapply concreteComposeEmpty in H19. inversion H19. subst. clear H19. + inversion H13. subst. clear H13. + Transparent basicEval. simpl in H19. Opaque basicEval. + destruct x; inversion H19. + destruct (findRecord n0 v1); inversion H6. + subst. clear H6. + inversion H16. subst. clear H16. + inversion H15. subst. clear H15. + inversion H16. subst. clear H16. + eapply concreteComposeEmpty in H19. inversion H19. subst. clear H19. + inversion H13. subst. clear H13. + Transparent basicEval. simpl in H19. Opaque basicEval. + inversion H19. + subst. clear H15. + inversion H16. subst. clear H16. + Transparent basicEval. simpl in H14. + inversion H19. subst. clear H19. inversion H6. subst. clear H6. + inversion H13. subst. clear H13. + eapply concreteComposeEmpty in H21. inversion H21. subst. clear H21. + inversion H16. subst. clear H16. + Transparent basicEval. simpl in H21. Opaque basicEval. + inversion H21. + subst. clear H16. + inversion H15. subst. clear H15. + inversion H19. subst. clear H19. + inversion H6. subst. clear H6. + inversion H13. subst. clear H13. + inversion H21. subst. clear H21. + inversion H6. subst. clear H6. + inversion H15. subst. clear H15. + eapply concreteComposeEmpty in H23. inversion H23. subst. clear H23. + inversion H19. subst. clear H19. + Transparent basicEval. simpl in H23. + destruct x3; inversion H23. + destruct (findRecord n0 v); inversion H6. + destruct (nth 3 l0 NoValue); inversion H22. +Qed. + +Theorem mergeTheorem1Aux7 : forall eee v v0 v1 v2 l v4 x x0 e, + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )---> (#2 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #2] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #1] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(#0, #4), #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8)), + #2)) (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + (forall x1 : Value, + NatValue 0 = x1 \/ + NatValue 1 = x1 \/ NatValue 2 = x1 \/ NatValue 3 = x1 \/ False -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8))]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: nil) + (eee, empty_heap)) -> + In x0 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @NatValue unit 0 = nth (eee varx) l NoValue -> + e <> 0 -> + @NatValue unit e = + (if match eee varx with + | 0 => false + | 1 => false + | 2 => false + | 3 => false + | S (S (S (S _))) => true + end + then NatValue 0 + else NatValue 1) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsExists range(#0, #4) + (([--( v(2), v(6) )---> (#2 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #2] *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #1]) ** + AbsAll range(#0, #4) + (([#0 ==== nth(replacenth(v(4), !!(varx), !!(valuex)), v(9))] *\/* + [--( v(2), v(6) )---> (#10 ++++ v(9)) ==== #0] ** + [#0 <<<< nth(replacenth(v(4), !!(varx), !!(valuex)), v(9))]) *\/* + ([!!(varx) ==== v(9)] ** + ([#0 <<<< --( v(2), v(6) )---> (#2 ++++ !!(varx))] ** + [!!(valuex) ==== #2] *\/* + [#0 <<<< --( v(2), v(6) )---> (#6 ++++ !!(varx))] ** + [!!(valuex) ==== #1]) *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + ([#0 <<<< + --( v(2), v(6) + )---> (#2 ++++ nth(find(v(0), v(10)), #3))] ** + [nth(find(v(0), v(10)), #4) ==== #2] *\/* + [#0 <<<< + --( v(2), v(6) + )---> (#6 ++++ nth(find(v(0), v(10)), #3))] ** + [nth(find(v(0), v(10)), #4) ==== #1]))) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + ([#0 <<<< + --( v(2), v(6) + )---> (#2 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #2] *\/* + [#0 <<<< + --( v(2), v(6) + )---> (#6 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #1])))))) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + 0 = + @mapSum unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) + (--( v(2), v(6) )---> (#2 ++++ v(8)) //\\ nth(v(4), v(8)) ==== #2 \\// + --( v(2), v(6) )---> (#6 ++++ v(8)) //\\ nth(v(4), v(8)) ==== #1) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll TreeRecords(v(0)) + ([--(v(0),v(8))-->stack_var_offset <<<< #var_count])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll TreeRecords(v(0)) + ([nth(v(4),--(v(0),v(8))-->stack_var_offset)====--(v(0),v(8))-->stack_val_offset])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + ([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [nth(v(4), v(8)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap). +Proof. + intros. + + eapply RSAll. Transparent basicEval. simpl. Opaque basicEval. reflexivity. reflexivity. + intros. simpl. + destruct x1; hypSimp. + remember (beq_nat n (eee varx)). + destruct b. + apply beq_nat_eq in Heqb. subst. + eapply RSOrComposeR. eapply RSR. + Transparent basicEval. simpl. Opaque basicEval. rewrite <- H3. simpl. + reflexivity. apply BTStatePredicate. intro X. inversion X. unfold empty_heap. reflexivity. + + inversion H6. subst. clear H6. inversion H18. subst. clear H18. + inversion H6. subst. clear H6. Transparent basicEval. simpl in H15. inversion H15. subst. clear H15. + simpl in H13. + inversion H13. subst. clear H13. + eapply concreteComposeEmpty in H19. inversion H19. subst. clear H19. + inversion H16. subst. clear H16. Transparent basicEval. simpl in H17. Opaque basicEval. + inversion H17. subst. clear H17. simpl in H20. + apply H20 in H11. clear H20. + + eapply removeReplace in H11. Focus 2. + instantiate (1 := (!!varx)). instantiate (1 := v(9)). instantiate (1 := (v + :: v0 + :: v1 + :: v2 + :: ListValue l :: v4 :: x :: x0 :: x1 :: NatValue n :: nil)). + instantiate (1 := eee). Transparent basicEval. simpl. Opaque basicEval. + rewrite <- Heqb. simpl. reflexivity. Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + inversion H11. subst. clear H11. + inversion H17. subst. clear H17. + eapply RSOrComposeR. + eapply dumpVar in H16. Focus 2. instantiate (1 := 8). simpl. reflexivity. + Focus 2. simpl. reflexivity. simpl in H16. + eapply expressionSubGRSRL. apply H16. simpl. reflexivity. simpl. reflexivity. + simpl. reflexivity. + eapply RSR. Transparent basicEval. simpl. reflexivity. apply BTStatePredicate. + omega. unfold empty_heap. reflexivity. + + subst. clear H17. + inversion H16. subst. clear H16. + eapply concreteComposeEmpty in H19. inversion H19. subst. clear H19. + eapply RSOrComposeL. + eapply dumpVar in H13. Focus 2. instantiate (1 := 8). simpl. reflexivity. + Focus 2. simpl. reflexivity. simpl in H13. + apply H13. + + subst. clear H11. + inversion H17. subst. clear H17. + inversion H16. subst. clear H16. + inversion H17. subst. clear H17. + inversion H13. subst. clear H13. + eapply concreteComposeEmpty in H19. inversion H19. subst. clear H19. + Transparent basicEval. simpl in H20. Opaque basicEval. + remember (beq_nat (eee varx) n). destruct b. + apply beq_nat_eq in Heqb0. subst. + erewrite <- beq_nat_refl in Heqb. inversion Heqb. + inversion H20. elim H11. reflexivity. + + subst. clear H16. + inversion H17. subst. clear H17. + inversion H19. subst. clear H19. + inversion H6. subst. clear H6. + inversion H13. subst. clear H13. + eapply concreteComposeEmpty in H21. inversion H21. subst. clear H21. + inversion H17. subst. clear H17. + Transparent basicEval. simpl in H21. Opaque basicEval. + remember (beq_nat (eee varx) n). destruct b. + apply beq_nat_eq in Heqb0. subst. + erewrite <- beq_nat_refl in Heqb. inversion Heqb. + inversion H21. elim H13. reflexivity. + + subst. clear H17. + inversion H16. subst. clear H16. + inversion H19. subst. clear H19. + inversion H6. subst. clear H6. + Transparent basicEval. simpl in H14. Opaque basicEval. + inversion H13. subst. clear H13. + Transparent basicEval. simpl in H18. Opaque basicEval. simpl in H21. + inversion H21. subst. clear H21. + inversion H6. subst. clear H6. + destruct x2; hypSimp. + inversion H16. subst. clear H16. + apply concreteComposeEmpty in H23. inversion H23. subst. clear H23. + + eapply mapSumNeg in H7. Focus 2. + instantiate (1 := + @absEval unit eq_unit (@basicEval unit) eee (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x3 :: nil) + nth(find(v(0),v(8)),#3)). + eapply subRangeSet in H13. Focus 2. apply H18. Focus 2. apply H11. Focus 2. apply H14. + inversion H9. subst. clear H9. + Transparent basicEval. simpl in H21. Opaque basicEval. + rewrite H14 in H21. inversion H21. subst. clear H21. simpl in H24. + apply H24 in H13. + Transparent basicEval. simpl. + inversion H13. subst. clear H13. Transparent basicEval. simpl in H22. Opaque basicEval. + destruct (match + match x3 with + | NatValue x => findRecord x v + | ListValue _ => NoValue + | NoValue => NoValue + | OtherValue _ => NoValue + end + with + | NatValue _ => NoValue + | ListValue l => nth 3 l NoValue + | NoValue => NoValue + | OtherValue _ => NoValue + end); hypSimp. + destruct n1. left. reflexivity. destruct n1. right. left. reflexivity. + destruct n1. right. right. left. reflexivity. destruct n1. right. right. right. left. reflexivity. + inversion H22. elim H9. reflexivity. + Opaque absEval. simpl in H7. Transparent absEval. + + eapply subBoundVar in H7. + Focus 2. instantiate (3 := 8). Opaque absEval. simpl. Transparent absEval. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + simplifyHyp H7. simplifyHyp H7. + + inversion H10. subst. clear H10. Transparent basicEval. simpl in H21. Opaque basicEval. + rewrite H14 in H21. inversion H21. subst. clear H21. + + eapply expressionSubRSLR in H7. Focus 2. eapply H24. + + eapply subRangeSet in H13. Focus 2. apply H18. Focus 2. apply H11. apply H13. apply H14. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + inversion H7. subst. clear H7. + eapply concreteComposeEmpty in H23. inversion H23. subst. clear H23. + inversion H20. subst. clear H20. + inversion H22. subst. clear H22. + eapply concreteComposeEmpty in H25. inversion H25. subst. clear H25. + inversion H16. + eapply dumpVar in H10. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H10. + eapply dumpVar in H10. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H10. + eapply dumpVar in H10. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H10. + eapply expressionSubRSNeg in H10. Focus 2. apply H23. Focus 2. simpl. reflexivity. Focus 2. + simpl. reflexivity. Focus 2. simpl. reflexivity. + inversion H10. subst. clear H10. Transparent basicEval. simpl in H30. Opaque basicEval. + inversion H30. subst. clear H30. elim H7. reflexivity. + eapply dumpVar in H20. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H20. + eapply dumpVar in H20. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H20. + eapply dumpVar in H20. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H20. + eapply expressionSubRSLR in H23. Focus 2. apply H20. Focus 2. simpl. reflexivity. Focus 2. + simpl. reflexivity. Focus 2. simpl. reflexivity. + inversion H23. subst. clear H23. Transparent basicEval. simpl in H30. Opaque basicEval. + inversion H30. subst. clear H30. elim H7. reflexivity. + + subst. clear H20. + inversion H22. subst. clear H22. + eapply concreteComposeEmpty in H25. inversion H25. subst. clear H25. + inversion H17. subst. clear H17. + eapply dumpVar in H10. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H10. + eapply dumpVar in H10. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H10. + eapply dumpVar in H10. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H10. + eapply expressionSubRSNeg in H10. Focus 2. apply H23. Focus 2. simpl. reflexivity. Focus 2. + simpl. reflexivity. Focus 2. simpl. reflexivity. + inversion H10. subst. clear H10. Transparent basicEval. simpl in H25. Opaque basicEval. + inversion H25. subst. clear H25. elim H7. reflexivity. + eapply dumpVar in H20. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H20. + eapply dumpVar in H20. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H20. + eapply dumpVar in H20. Focus 2. instantiate (1 := 8). simpl. reflexivity. Focus 2. simpl. reflexivity. + simpl in H20. + eapply expressionSubRSLR in H23. Focus 2. apply H20. Focus 2. simpl. reflexivity. Focus 2. + simpl. reflexivity. Focus 2. simpl. reflexivity. + inversion H23. subst. clear H23. Transparent basicEval. simpl in H30. Opaque basicEval. + inversion H30. subst. clear H30. elim H7. reflexivity. +Qed. + +Theorem mergeTheorem1Aux6 : forall e v v0 v1 v2 l v4 x x0 eee, + In x0 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + e <> 0 -> + NatValue e = + (if match eee varx with + | 0 => false + | 1 => false + | 2 => false + | 3 => false + | S (S (S (S _))) => true + end + then NatValue 0 + else @NatValue unit 1) -> + NatValue 0 = nth (eee varx) l NoValue -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + ([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + length l=4 -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + ([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [nth(v(4), v(8)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap). +Proof. + intros. + + inversion H3. subst. clear H3. Transparent basicEval. simpl in H9. Opaque basicEval. + inversion H9. subst. clear H9. + + eapply RSAll. Transparent basicEval. simpl. Opaque basicEval. simpl. reflexivity. reflexivity. + intros. + apply H12 in H3. clear H12. + simpl in H3. simpl. + + inversion H3. subst. clear H3. + eapply RSOrComposeL. apply H10. + + subst. clear H3. + inversion H10. subst. clear H10. Transparent basicEval. simpl in H11. Opaque basicEval. + + destruct x1. + + remember (beq_nat n (eee varx)). + destruct b. + + apply beq_nat_eq in Heqb. subst. + rewrite nth_replace_same in H11. + + inversion H4. subst. clear H4. + inversion H9. subst. clear H9. Transparent basicEval. simpl in H10. Opaque basicEval. + destruct (eee valuex). simpl in H10. inversion H10. + + elim H4. reflexivity. + + simpl in H11. inversion H11. subst. clear H11. elim H4. reflexivity. + + subst. clear H4. + + inversion H9. subst. clear H9. Transparent basicEval. simpl in H10. Opaque basicEval. + destruct (eee valuex). simpl in H10. inversion H10. + elim H4. reflexivity. + + simpl in H11. inversion H11. subst. clear H11. elim H4. reflexivity. + + reflexivity. rewrite H5. + destruct (eee varx). omega. destruct n. omega. destruct n. omega. destruct n. omega. + inversion H1. subst. elim H0. reflexivity. + + apply beq_nat_neq in Heqb. + + rewrite nth_replace_diff in H11. + inversion H11. subst. clear H11. + + eapply RSOrComposeR. + eapply RSR. Transparent basicEval. simpl. Opaque basicEval. + + rewrite <- H3. reflexivity. eapply BTStatePredicate. apply H6. + + unfold empty_heap. simpl. reflexivity. + apply Heqb. + + inversion H11. inversion H11. inversion H11. +Qed. + +Theorem mergeTheorem1Aux5 : forall eee v v0 v1 v2 l v4 x x0 e, + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )---> (#2 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #2] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #1] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + In x0 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + e <> 0 -> + NatValue e = + (if match eee varx with + | 0 => false + | 1 => false + | 2 => false + | 3 => false + | S (S (S (S _))) => true + end + then NatValue 0 + else @NatValue unit 1) -> + NatValue 0 = nth (eee varx) l NoValue -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )---> (#2 ++++ v(7))] ** + ([nth(v(4), v(7)) ==== #2] *\/* [nth(v(4), v(7)) ==== #0]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(7))] ** + ([nth(v(4), v(7)) ==== #1] *\/* [nth(v(4), v(7)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap). +Proof. + Transparent basicEval. + intros. + destructState. hypSimp. inversion H; subst; clear H; hypSimp. + inversion H8. subst. clear H8. + eapply concreteComposeEmpty in H10. inversion H10; subst; clear H10. + eapply RSOrComposeL. + eapply RSCompose. apply H5. + inversion H6. subst. clear H6. destructState. hypSimp. + destruct x0; hypSimp. + remember (beq_nat n (eee varx)). destruct b. apply beq_nat_eq in Heqb. subst. + eapply RSOrComposeR. eapply RSR. simpl. reflexivity. + rewrite <- H3. simpl. + eapply BTStatePredicate. intro X. inversion X. instantiate (1 := (eee,empty_heap)). + unfold empty_heap. reflexivity. + apply beq_nat_neq in Heqb. + erewrite nth_replace_diff in HeqH. + apply RSOrComposeL. eapply RSR. simpl. reflexivity. + rewrite <- HeqH. simpl. + apply BTStatePredicate. intro X. inversion X. + unfold empty_heap. reflexivity. apply Heqb. + + subst. clear H6. destructState. hypSimp. + destruct x0; hypSimp. + remember (beq_nat n (eee varx)). destruct b. apply beq_nat_eq in Heqb. subst. + eapply RSOrComposeR. eapply RSR. simpl. reflexivity. + rewrite <- H3. simpl. + eapply BTStatePredicate. intro X. inversion X. + unfold empty_heap. reflexivity. + apply beq_nat_neq in Heqb. + erewrite nth_replace_diff in HeqH. + apply RSOrComposeR. eapply RSR. Transparent basicEval. simpl. reflexivity. + rewrite <- HeqH. simpl. + apply BTStatePredicate. intro X. inversion X. + unfold empty_heap. reflexivity. apply Heqb. + apply concreteComposeEmpty. split. reflexivity. reflexivity. + + inversion H8. subst. clear H8. + eapply concreteComposeEmpty in H10. inversion H10; subst; clear H10. + eapply RSOrComposeR. + eapply RSCompose. apply H5. + inversion H6. subst. clear H6. destructState. hypSimp. + destruct x0; hypSimp. + remember (beq_nat n (eee varx)). destruct b. apply beq_nat_eq in Heqb. subst. + eapply RSOrComposeR. eapply RSR. simpl. reflexivity. + rewrite <- H3. simpl. + eapply BTStatePredicate. intro X. inversion X. instantiate (1 := (eee,empty_heap)). + unfold empty_heap. reflexivity. + apply beq_nat_neq in Heqb. + erewrite nth_replace_diff in HeqH. + apply RSOrComposeL. eapply RSR. Transparent basicEval. simpl. reflexivity. + rewrite <- HeqH. simpl. + apply BTStatePredicate. intro X. inversion X. + unfold empty_heap. reflexivity. apply Heqb. + + subst. clear H6. Transparent basicEval. destructState. + hypSimp. + destruct x0; hypSimp. + remember (beq_nat n (eee varx)). destruct b. apply beq_nat_eq in Heqb. subst. + eapply RSOrComposeR. eapply RSR. simpl. reflexivity. + rewrite <- H3. simpl. + eapply BTStatePredicate. intro X. inversion X. + unfold empty_heap. reflexivity. + apply beq_nat_neq in Heqb. + erewrite nth_replace_diff in HeqH. + apply RSOrComposeR. eapply RSR. Transparent basicEval. simpl. reflexivity. Opaque basicEval. + rewrite <- HeqH. simpl. + apply BTStatePredicate. intro X. inversion X. + unfold empty_heap. reflexivity. apply Heqb. + apply concreteComposeEmpty. split. reflexivity. reflexivity. + Opaque basicEval. +Qed. + +Theorem mergeTheorem1Aux4b : forall v v0 v1 v2 l v4 x x0 eee x1 x2, + (forall x1 : Value, + In x1 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8))]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: nil) + (eee, empty_heap)) -> + (In x0 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil)) -> + (@NatValue unit 1 = + (if match eee varx with + | 0 => false + | 1 => false + | 2 => false + | 3 => false + | S (S (S (S _))) => true + end + then NatValue 0 + else NatValue 1)) -> + (@NatValue unit 0 = nth (eee varx) l NoValue) -> + (forall x1 : Value, + In x1 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + (((((([--( v(2), v(6) )---> (#10 ++++ v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) *\/* + [~~ --( v(2), v(6) )---> (#10 ++++ v(9))]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #0]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(9)) ==== + #0]) *\/* [v(8) ==== v(9)]) *\/* + ([!!(varx) ==== v(9)] ** [!!(varx) ==== v(8)] *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + [nth(find(v(0), v(10)), #3) ==== v(8)])) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + [nth(find(v(0), v(11)), #3) ==== v(8)])))) + ((v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) ++ + x1 :: nil) (eee, empty_heap)) -> + (forall x1 : Value, + In x1 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0] *\/* + [#0 <<<< nth(replacenth(v(4), !!(varx), !!(valuex)), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) + (*([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0] *\/* + [#0 ==== nth(replacenth(v(4), !!(varx), !!(valuex)), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0])*) + ((v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) ++ + x1 :: nil) (eee, empty_heap)) -> + (false = + validPredicate + (@absEval unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (#0 ==== --( v(2), v(6) )---> (#10 ++++ !!(varx))))) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + length l = 4 -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(#0, #4), + #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8)) //\\ + ((--( v(2), v(6) )---> (#2 ++++ v(8)) \\// + --( v(2), v(6) )---> (#6 ++++ v(8))) //\\ + nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0), + #1)) (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, fun _ : nat => None) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#1 ==== + (v(8) ++++ v(9)) ++++ + (#0 <<<< --( v(2), v(6) )---> (#10 ++++ !!(varx)) //\\ + (~~ --( v(2), v(6) )---> (#2 ++++ !!(varx)) //\\ + ~~ --( v(2), v(6) )---> (#6 ++++ !!(varx)) \\// + #0 <<<< nth(replacenth(v(4), !!(varx), !!(valuex)), !!(varx))))]) + (v + :: v0 + :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 ==== v(9)]) + (v + :: v0 + :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 ==== v(8)]) + (v + :: v0 + :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(!!(varx) ++++ #1, #4), + #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(10)) //\\ + (~~ --( v(2), v(6) )---> (#2 ++++ v(10)) //\\ + ~~ --( v(2), v(6) )---> (#6 ++++ v(10)) \\// + #0 <<<< nth(v(4), v(10))), #0)) + (v + :: v0 + :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + (eee, fun _ : nat => None) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(#0, #4), + #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(10)) //\\ + (~~ --( v(2), v(6) )---> (#2 ++++ v(10)) //\\ + ~~ --( v(2), v(6) )---> (#6 ++++ v(10)) \\// + #0 <<<< nth(v(4), v(10))), + #0 <<<< --( v(2), v(6) )---> (#10 ++++ !!(varx)) //\\ + (~~ --( v(2), v(6) )---> (#2 ++++ !!(varx)) //\\ + ~~ --( v(2), v(6) )---> (#6 ++++ !!(varx))))) + (v + :: v0 + :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + (eee, fun _ : nat => None) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + ([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [nth(v(4), v(8)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap). +Proof. + intros. + + assert (forall x1 : Value, + In x1 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8))]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: nil) + (eee, empty_heap)). + apply H. + + eapply expressionSubEvalEval in H. + Focus 2. instantiate (1 := v(8)). instantiate (2 := eee). instantiate (2 := (!!varx)). + Transparent basicEval. simpl. Opaque basicEval. reflexivity. + Focus 2. + destruct (eee varx). simpl. left. reflexivity. destruct n. simpl. right. left. reflexivity. + destruct n. simpl. right. right. left. reflexivity. destruct n. simpl. right. right. right. left. + reflexivity. inversion H1. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + eapply expressionNotEqualZero3 in H. Focus 2. apply H5. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. reflexivity. Focus 2. simpl. reflexivity. + + simplifyHyp H. + + assert (@absEval unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l + :: v4 :: x :: x0 :: NatValue (eee varx) :: nil) + (~~ --( v(2), v(6) )---> (#2 ++++ !!(varx)) //\\ + ~~ --( v(2), v(6) )---> (#6 ++++ !!(varx)))=NatValue 0). + inversion H. subst. clear H. + erewrite expressionSubGRSNeg. Focus 2. apply H19. Focus 2. simpl. reflexivity. Focus 2. + simpl. reflexivity. Focus 2. simpl. reflexivity. + + Transparent basicEval. simpl. Opaque basicEval. reflexivity. + simpl. reflexivity. + + erewrite expressionSubGRSNeg. Focus 2. apply H19. Focus 2. simpl. reflexivity. Focus 2. + simpl. reflexivity. Focus 2. simpl. reflexivity. + + erewrite <- simplifyAbsEval. Focus 2. compute. reflexivity. + Transparent basicEval. simpl. Opaque basicEval. reflexivity. + + simpl. reflexivity. + + eapply expressionSubEval in H13. + + Focus 2. instantiate (4 := 0). rewrite <- H15. reflexivity. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + simplifyHyp H13. + + eapply resolveSum8x10 in H13. + Focus 2. intros. eapply H14. apply H16. Focus 2. simpl. reflexivity. Focus 2. + instantiate (1 := (#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(10)) //\\ + #0 <<<< nth(v(4), v(10)))). + simpl. intros. + simplifyHyp H17. simplifyHyp H17. + inversion H17. subst. clear H17. inversion H22. subst. clear H22. + eapply expressionSubGRSLR. apply H21. simpl. reflexivity. simpl. reflexivity. simpl. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply RSEmpty. unfold empty_heap. reflexivity. + subst. clear H22. + eapply expressionSubGRSNeg1. apply H21. simpl. reflexivity. simpl. reflexivity. simpl. reflexivity. + simpl. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply RSEmpty. unfold empty_heap. reflexivity. + subst. clear H17. + eapply expressionSubGRSNeg1. apply H22. simpl. reflexivity. simpl. reflexivity. simpl. reflexivity. + simpl. reflexivity. + eapply simplifyEquiv2. compute. reflexivity. + eapply RSEmpty. unfold empty_heap. reflexivity. + + eapply sumAllConv in H13. + simplifyHyp H13. simplifyHyp H13. simplifyHyp H13. simplifyHyp H13. + + eapply dumpVar in H13. Focus 2. instantiate (1 := 8). simpl. reflexivity. + Focus 2. simpl. reflexivity. simpl in H13. + eapply dumpVar in H13. Focus 2. instantiate (1 := 8). simpl. reflexivity. + Focus 2. simpl. reflexivity. simpl in H13. simpl. + unfold empty_heap. apply H13. + + Transparent basicEval. simpl. reflexivity. Opaque basicEval. +Grab Existential Variables. + apply (fun a b c d e f => a=a). apply (fun a b c => a=a). +Qed. + +Theorem mergeTheorem1Aux4 : forall v v0 v1 v2 l v4 x x0 eee, + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(#0, #4), #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8)), + #2)) (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + (forall x1 : Value, + NatValue 0 = x1 \/ + NatValue 1 = x1 \/ NatValue 2 = x1 \/ NatValue 3 = x1 \/ False -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8))]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: nil) (eee, empty_heap)) -> + In x0 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + NatValue 1 = + (if match eee varx with + | 0 => false + | 1 => false + | 2 => false + | 3 => false + | S (S (S (S _))) => true + end + then @NatValue unit 0 + else NatValue 1) -> + NatValue 0 = nth (eee varx) l NoValue -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(#0, #4), + (--( v(2), v(6) )---> (#2 ++++ v(8)) \\// + --( v(2), v(6) )---> (#6 ++++ v(8))) //\\ + nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0, + #1)) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + (forall x1 : Value, + In x1 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + (((((([--( v(2), v(6) )---> (#10 ++++ v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) *\/* + [~~ --( v(2), v(6) )---> (#10 ++++ v(9))]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #0]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(9)) ==== + #0]) *\/* [v(8) ==== v(9)]) *\/* + ([!!(varx) ==== v(9)] ** [!!(varx) ==== v(8)] *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + [nth(find(v(0), v(10)), #3) ==== v(8)])) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + [nth(find(v(0), v(11)), #3) ==== v(8)])))) + ((v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) ++ + x1 :: nil) (eee, empty_heap)) -> + (forall x1 : Value, + In x1 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0] *\/* + [#0 <<<< nth(replacenth(v(4), !!(varx), !!(valuex)), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) + ((v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) ++ + x1 :: nil) (eee, empty_heap)) -> + false = + validPredicate + (@absEval unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (#0 ==== --( v(2), v(6) )---> (#10 ++++ !!(varx)))) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + length l=4 -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + ([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [nth(v(4), v(8)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap). +Proof. + intros. + + eapply andSum8 in H4. Focus 2. apply H6. Focus 2. simpl. reflexivity. Focus 2. + Transparent basicEval. simpl. Opaque basicEval. reflexivity. + + simplifyHyp H4. simplifyHyp H4. simplifyHyp H4. + simplifyHyp H. + + eapply sumDiff in H. Focus 2. eapply H4. Focus 2. simpl. reflexivity. + + simplifyHyp H. simplifyHyp H. + + eapply unfoldSum in H. Focus 2. simpl. reflexivity. Focus 2. instantiate (1 := (!!varx)). simpl. reflexivity. + Focus 2. Transparent basicEval. simpl. Opaque basicEval. + destruct (eee varx). reflexivity. destruct n. reflexivity. destruct n. reflexivity. + destruct n. reflexivity. destruct n. reflexivity. inversion H2. + + simpl in H. inversion H. subst. clear H. inversion H11. subst. clear H11. + inversion H. subst. clear H. inversion H11. subst. clear H11. inversion H. subst. clear H. + inversion H13. subst. clear H13. + eapply concreteComposeEmpty in H16. inversion H16. subst. clear H16. + eapply concreteComposeEmpty in H18. inversion H18. subst. clear H18. + simpl in H14. + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#1 ==== + (v(8) ++++ v(9)) ++++ + (#0 <<<< --( v(2), v(6) )---> (#10 ++++ !!(varx)))]) + (v + :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + (eee, empty_heap)). + eapply removeReplaceSame in H14. Focus 2. instantiate (1 := !!(varx)). instantiate (1 := v(4)). + simpl. reflexivity. Focus 2. Transparent basicEval. simpl. reflexivity. Focus 2. + simpl. reflexivity. Opaque basicEval. + + inversion H8. subst. clear H8. + eapply expressionSubRSLR in H14. Focus 2. apply H16. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + simplifyHyp H14. simplifyHyp H14. simplifyHyp H14. + apply H14. + subst. clear H8. + eapply expressionSubRSLR in H14. Focus 2. apply H16. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + simplifyHyp H14. simplifyHyp H14. simplifyHyp H14. + apply H14. + rewrite H9. destruct (eee varx). omega. destruct n. omega. destruct n. omega. destruct n. omega. + inversion H2. + + simplifyHyp H11. simplifyHyp H12. + + eapply expressionNotEqualZero1 in H. Focus 2. apply H7. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. reflexivity. Focus 2. simpl. reflexivity. + + simplifyHyp H. simplifyHyp H. + + inversion H. subst. clear H. + eapply concreteComposeEmpty in H19. inversion H19. subst. clear H19. + + eapply expressionSubRSRL in H11. Focus 2. apply H16. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + eapply expressionSubRSRL in H12. Focus 2. apply H15. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + eapply foldSum in H12. Focus 2. apply H11. Focus 2. simpl. reflexivity. + simplifyHyp H12. + + eapply expressionSubEval in H12. + Focus 2. instantiate (1 := (nth(v(4), !!(varx)))). instantiate (2 := eee). + instantiate (1 := (v + :: v0 + :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil)). + Transparent basicEval. simpl. rewrite <- H3. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + simplifyHyp H12. + + eapply mergeTheorem1Aux4b. apply H0. apply H1. apply H2. apply H3. apply H5. apply H6. + apply H7. apply H8. apply H9. apply H4. apply H14. apply H16. apply H15. apply H11. + apply H12. +Qed. + +Theorem mergeTheorem1Aux3 : forall eee l v v0 v1 v2 v4 x x0 x1 x2, + (match eee varx with + | 0 => true + | 1 => true + | 2 => true + | 3 => true + | S (S (S (S _))) => false + end=true) -> + NatValue 0 = nth (eee varx) l NoValue -> + true = + validPredicate + (@absEval unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (#0 ==== --( v(2), v(6) )---> (#10 ++++ !!(varx)))) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (((((([--( v(2), v(6) )---> (#10 ++++ v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) *\/* + [~~ --( v(2), v(6) )---> (#10 ++++ v(9))]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #0]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(9)) ==== + #0]) *\/* [v(8) ==== v(9)]) *\/* + ([!!(varx) ==== v(9)] ** [!!(varx) ==== v(8)] *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + [nth(find(v(0), v(10)), #3) ==== v(8)])) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + [nth(find(v(0), v(11)), #3) ==== v(8)]))) + (v + :: v0 + :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + (eee, empty_heap) -> + length l=4 -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (((((([--( v(2), v(6) )---> (#10 ++++ v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) *\/* + [~~ --( v(2), v(6) )---> (#10 ++++ v(9))]) *\/* + [nth(v(4), v(8)) ==== #0]) *\/* [nth(v(4), v(9)) ==== #0]) *\/* + [v(8) ==== v(9)]) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + [nth(find(v(0), v(11)), #3) ==== v(8)]))) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + (eee, empty_heap). +Proof. + intros. + + inversion H2. subst. clear H2. + inversion H9. subst. clear H9. + inversion H8. subst. clear H8. + inversion H9. subst. clear H9. + inversion H8. subst. clear H8. + + eapply RSOrComposeL. eapply RSOrComposeL. eapply RSOrComposeL. eapply RSOrComposeL. eapply RSOrComposeL. + apply H9. + + subst. clear H8. + eapply RSOrComposeL. eapply RSOrComposeL. eapply RSOrComposeL. eapply RSOrComposeL. eapply RSOrComposeR. + apply H9. + + subst. clear H9. + + eapply RSOrComposeL. eapply RSOrComposeL. eapply RSOrComposeL. eapply RSOrComposeR. + + remember (validPredicate (@absEval unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + ( (!!varx) ==== (v(8)) ))). + destruct b. + + eapply expressionSubRL in H8. Focus 2. rewrite Heqb. reflexivity. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + inversion H8. subst. clear H8. Transparent basicEval. simpl in H10. Opaque basicEval. + + erewrite nth_replace_same in H10. + + inversion H4. subst. clear H4. inversion H8. subst. clear H8. Transparent basicEval. simpl in H9. + Opaque basicEval. + + destruct (eee valuex). simpl in H9. inversion H9. elim H4. reflexivity. + simpl in H10. inversion H10. elim H4. reflexivity. + + inversion H8. subst. clear H8. Transparent basicEval. simpl in H15. + Opaque basicEval. + + destruct (eee valuex). simpl in H15. inversion H15. elim H5. reflexivity. + simpl in H10. inversion H10. elim H5. reflexivity. reflexivity. + + rewrite H3. + destruct (eee varx). omega. destruct n. omega. destruct n. omega. destruct n. omega. + inversion H. + + eapply removeReplace in H8. Focus 6. instantiate (1 := (!!varx)). instantiate (1 := v(8)). + simpl. reflexivity. Focus 2. rewrite validPredicateSymmetry. rewrite Heqb. reflexivity. + + apply H8. simpl. reflexivity. simpl. reflexivity. simpl. reflexivity. + + subst. clear H8. + + eapply RSOrComposeL. eapply RSOrComposeL. eapply RSOrComposeR. + + remember (validPredicate (@absEval unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + ( (!!varx) ==== (v(9)) ))). + destruct b. + + eapply expressionSubRL in H9. Focus 2. rewrite Heqb. reflexivity. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + inversion H9. subst. clear H9. Transparent basicEval. simpl in H10. Opaque basicEval. + + erewrite nth_replace_same in H10. + + inversion H4. subst. clear H4. inversion H8. subst. clear H8. Transparent basicEval. simpl in H9. + Opaque basicEval. + + destruct (eee valuex). simpl in H9. inversion H9. elim H4. reflexivity. + simpl in H10. inversion H10. elim H4. reflexivity. + + inversion H8. subst. clear H8. Transparent basicEval. simpl in H15. + Opaque basicEval. + + destruct (eee valuex). simpl in H15. inversion H15. elim H5. reflexivity. + simpl in H10. inversion H10. elim H5. reflexivity. reflexivity. + + rewrite H3. + destruct (eee varx). omega. destruct n. omega. destruct n. omega. destruct n. omega. + inversion H. + + eapply removeReplace in H9. Focus 6. instantiate (1 := (!!varx)). instantiate (1 := v(9)). + simpl. reflexivity. Focus 2. rewrite validPredicateSymmetry. rewrite Heqb. reflexivity. + + apply H9. simpl. reflexivity. simpl. reflexivity. simpl. reflexivity. + + eapply RSOrComposeL. eapply RSOrComposeR. apply H8. + + subst. + + inversion H9. subst. clear H9. + inversion H10. subst. clear H10. + + inversion H9. subst. clear H9. + + apply concreteComposeEmpty in H12. inversion H12. subst. clear H12. + + apply RSOrComposeL. apply RSOrComposeL. eapply RSOrComposeL. eapply RSOrComposeL. + apply RSOrComposeR. + + eapply expressionSubGRSRL. apply H8. simpl. reflexivity. simpl. reflexivity. + simpl. reflexivity. + + eapply expressionSubGRSRL. apply H7. simpl. reflexivity. simpl. reflexivity. + simpl. reflexivity. + + eapply expressionSubGRL. rewrite H1. reflexivity. simpl. reflexivity. simpl. reflexivity. + simpl. reflexivity. simpl. reflexivity. + + eapply RSR. Transparent basicEval. simpl. + + reflexivity. eapply BTStatePredicate. omega. Opaque basicEval. + simpl. unfold empty_heap. reflexivity. + + subst. clear H10. + + eapply RSOrComposeL. eapply RSOrComposeL. eapply RSOrComposeR. + + inversion H9. subst. clear H9. inversion H12. subst. clear H12. inversion H5. subst. clear H5. + inversion H7. subst. clear H7. + + apply concreteComposeEmpty in H14. inversion H14. subst. clear H14. + + eapply expressionSubGRSRL. apply H10. simpl. reflexivity. simpl. reflexivity. simpl. reflexivity. + + Transparent basicEval. eapply RSR. simpl. rewrite <- H0. simpl. reflexivity. + apply BTStatePredicate. omega. unfold empty_heap. reflexivity. + + subst. eapply RSOrComposeR. apply H10. + + Opaque basicEval. +Qed. + +Theorem mergeTheorem1Aux2 : forall v v0 v1 v2 l v4 x x0 x1 eee, + true = validPredicate + (@absEval unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (#0 ==== --( v(2), v(6) )---> (#10 ++++ !!varx))) -> + + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0] *\/* + [#0 <<<< nth(replacenth(v(4), !!(varx), !!(valuex)), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: nil) (eee, empty_heap) -> + NatValue 0 = nth (eee varx) l NoValue -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + length l=4 -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )---> (#2 ++++ !!(varx)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ !!(varx)) ==== #0]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(v(4), v(8)) ==== #0] *\/* + [#0 <<<< nth(v(4), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: nil) (eee, empty_heap). +Proof. + intros. + + inversion H0. subst. clear H0. inversion H9. subst. clear H9. + apply concreteComposeEmpty in H11. inversion H11. subst. clear H11. + + remember (validPredicate (@absEval unit eq_unit (@basicEval unit) eee (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: nil) + ((!!varx)====v(8)))). + destruct b. + + eapply expressionSubRL in H6. Focus 2. rewrite Heqb. reflexivity. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + eapply expressionSubRL in H6. Focus 2. rewrite H. reflexivity. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + inversion H6. subst. clear H6. Transparent basicEval. simpl in H11. Opaque basicEval. + inversion H11. elim H5. reflexivity. + + eapply removeReplace in H7. Focus 2. rewrite Heqb. reflexivity. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + eapply RSOrComposeL. eapply RSCompose. apply H6. apply H7. apply concreteComposeEmpty. + split. reflexivity. reflexivity. + + subst. + + eapply expressionSubRL in H9. Focus 2. rewrite H. reflexivity. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + eapply RSOrComposeR. + + inversion H9. subst. clear H9. + + remember (validPredicate (@absEval unit eq_unit (@basicEval unit) eee (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: nil) + ((!!varx)====v(8)))). + destruct b. + + eapply expressionSubGRL. rewrite Heqb. reflexivity. simpl. reflexivity. + simpl. reflexivity. simpl. reflexivity. simpl. reflexivity. + + eapply RSOrComposeR. + eapply dumpVar2. Focus 2. instantiate (1 := 7). simpl. reflexivity. simpl. + eapply dumpVar2. Focus 2. instantiate (1 := 7). simpl. reflexivity. simpl. + apply H4. + Focus 2. simpl. reflexivity. simpl. reflexivity. + + eapply removeReplace in H10. Focus 2. rewrite Heqb. reflexivity. Focus 2. simpl. reflexivity. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. + + eapply RSOrComposeL. apply H10. + + subst. + + eapply RSOrComposeR. apply H10. +Qed. + +Theorem mergeTheorem1Aux1 : forall eee v v0 v1 v2 l v4 x x0, + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(#0, #4), + (--( v(2), v(6) )---> (#2 ++++ v(8)) \\// + --( v(2), v(6) )---> (#6 ++++ v(8))) //\\ + (nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0), #1)) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + (forall x1, In x1 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0] *\/* + [#0 <<<< nth(replacenth(v(4), !!(varx), !!(valuex)), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 ::nil) (eee, empty_heap)) -> + true = validPredicate + (@absEval unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (#0 ==== --( v(2), v(6) )---> (#10 ++++ !!(varx)))) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + ble_nat 4 (eee varx)=false -> + length l = 4 -> + NatValue 0 = nth (eee varx) l NoValue -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )---> (#2 ++++ !!(varx)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ !!(varx)) ==== #0]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(#0, #4), + (--( v(2), v(6) )---> (#2 ++++ v(8)) \\// + --( v(2), v(6) )---> (#6 ++++ v(8))) //\\ nth(v(4), v(8)) ==== #0, + #1)) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap). +Proof. + intros. + + eapply unfoldSum in H. + Focus 2. simpl. reflexivity. Focus 2. simpl. reflexivity. instantiate (1 := (!!varx)) in H. + simpl in H. + destructState1. + + simplifyHyp H8. + simplifyHyp H7. + + eapply unfoldSum. + simpl. reflexivity. simpl. reflexivity. instantiate (1 := !!(varx)). + + Transparent basicEval. simpl. Opaque basicEval. + simpl in H3. destruct (eee varx). reflexivity. destruct n. reflexivity. destruct n. reflexivity. + destruct n. reflexivity. inversion H3. + eapply RSExistsU. eapply ex_intro. eapply RSExistsU. eapply ex_intro. simpl. + eapply RSCompose. apply H8. eapply RSCompose. apply H7. + + clear H8. clear H7. + + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0] *\/* + ([#0 <<<< nth(replacenth(v(4), !!(varx), !!(valuex)), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: NatValue (eee varx) :: nil) + (eee, empty_heap)). + eapply H0. + destruct (eee varx). simpl. left. reflexivity. destruct n. simpl. right. left. reflexivity. + destruct n. right. right. left. reflexivity. destruct n. right. right. right. left. reflexivity. + simpl in H3. inversion H3. + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ (!!varx))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), (!!varx)) ==== #0] *\/* + ([#0 <<<< nth(replacenth(v(4), !!(varx), !!(valuex)), (!!varx))] *\/* + [--( v(2), v(6) )---> (#2 ++++ (!!varx)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ (!!varx)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: NatValue (eee varx) :: nil) + (eee, empty_heap)). + eapply removeQuantVar. apply H. instantiate (2 := 8). simpl. reflexivity. simpl. reflexivity. + + eapply expressionSubRSLR in H12. Focus 2. apply H10. Focus 2. simpl. reflexivity. Focus 2. simpl. + reflexivity. Focus 2. simpl. reflexivity. + eapply expressionSubRSLR in H12. Focus 2. apply H9. Focus 2. simpl. reflexivity. Focus 2. simpl. + reflexivity. Focus 2. simpl. reflexivity. + simplifyHyp H12. + eapply expressionSubGRSLR. apply H9. simpl. reflexivity. simpl. reflexivity. simpl. reflexivity. + eapply expressionSubGRSLR. apply H10. simpl. reflexivity. simpl. reflexivity. simpl. reflexivity. + eapply simplifyEquiv2. + compute. reflexivity. apply H12. + apply concreteComposeEmpty. split. reflexivity. reflexivity. + apply concreteComposeEmpty. split. reflexivity. reflexivity. + + + Transparent basicEval. simpl. Opaque basicEval. destruct (eee varx). + reflexivity. destruct n. reflexivity. destruct n. reflexivity. destruct n. reflexivity. + destruct n. reflexivity. simpl in H3. inversion H3. +Qed. + diff --git a/PEDANTIC/SatSolverMergeTheorem1P2.v b/PEDANTIC/SatSolverMergeTheorem1P2.v new file mode 100644 index 0000000..e4d1985 --- /dev/null +++ b/PEDANTIC/SatSolverMergeTheorem1P2.v @@ -0,0 +1,184 @@ +(********************************************************************************** + * The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic + * Traversal of Instruction Code) verification framework + * + * Developed by Kenneth Roe + * For more information, check out www.cs.jhu.edu/~roe + * + * TreeTraversal.v + * This file contains the proof of correctness of a tree traversal algorithm using + * the PEDANTIC verification framework. + * + **********************************************************************************) + +Require Export SfLib. +Require Export SfLibExtras. +Require Export ImpHeap. +Require Export AbsState. +Require Export AbsExecute. +Require Export AbsStateInstance. +Require Export Simplify. +Require Export Eqdep. +Require Export StateImplication. +Require Export Classical. +Require Export Unfold. +Require Export Fold. +Require Export merge. +Require Export ProgramTactics. +Require Export SatSolverDefs. +Require Export SatSolverMergeTheorem1P1. +Opaque basicEval. + +Theorem mergeTheorem1Aux9b : forall v v0 v1 v2 l v4 x x0 eee e x1 x2 x3, + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )---> (#2 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #2] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #1] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + (forall x1 : Value, + NatValue 0 = x1 \/ + NatValue 1 = x1 \/ NatValue 2 = x1 \/ NatValue 3 = x1 \/ False -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8))]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: nil) + (eee, empty_heap)) -> + In x0 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + NatValue 0 = nth (eee varx) l NoValue -> + e <> 0 -> + NatValue e = + (if match eee varx with + | 0 => false + | 1 => false + | 2 => false + | 3 => false + | S (S (S (S _))) => true + end + then NatValue 0 + else @NatValue unit 1) -> + (forall x1 : Value, + In x1 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + (((((([--( v(2), v(6) )---> (#10 ++++ v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) *\/* + [~~ --( v(2), v(6) )---> (#10 ++++ v(9))]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #0]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(9)) ==== + #0]) *\/* [v(8) ==== v(9)]) *\/* + ([!!(varx) ==== v(9)] ** [!!(varx) ==== v(8)] *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + [nth(find(v(0), v(10)), #3) ==== v(8)])) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + [nth(find(v(0), v(11)), #3) ==== v(8)])))) + ((v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) ++ + x1 :: nil) (eee, empty_heap)) -> + (forall x1 : Value, + In x1 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0] *\/* + [#0 <<<< nth(replacenth(v(4), !!(varx), !!(valuex)), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) + ((v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) ++ + x1 :: nil) (eee, empty_heap)) -> + true = + validPredicate + (@absEval unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (#0 ==== --( v(2), v(6) )---> (#10 ++++ !!(varx)))) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + ([nth(v(4), v(6)) ==== #0] *\/* + [!!(varx) ==== v(6)] *\/* + AbsExists TreeRecords(v(0)) + ([nth(find(v(0), v(7)), #3) ==== v(6)] ** + [nth(find(v(0), v(7)), #4) ==== nth(v(4), v(6))]))) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll TreeRecords(v(0)) + ([~~ (!!(varx) ==== nth(find(v(0), v(6)), #3))])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(!!(varx) ++++ #1, #4), + #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(10)) //\\ + ((--( v(2), v(6) )---> (#2 ++++ v(10)) \\// + --( v(2), v(6) )---> (#6 ++++ v(10))) //\\ + nth(v(4), v(10)) ==== #0), v(9))) + (v + :: v0 + :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + (eee, fun _ : nat => None) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#1 ==== v(8) ++++ v(9)]) + (v + :: v0 + :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + (eee, fun _ : nat => None) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(#0, #4), + #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(10)) //\\ + nth(v(4), v(10)) ==== #0, #1)) + (v + :: v0 + :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: x2 :: nil) + (eee, fun _ : nat => None) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (((((([--( v(2), v(6) )---> (#10 ++++ !!(varx))] *\/* + [--( v(2), v(6) )---> (#2 ++++ !!(varx)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ !!(varx)) ==== #0]) *\/* + [~~ --( v(2), v(6) )---> (#10 ++++ v(9))]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), !!(varx)) ==== #0]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(9)) ==== #0]) *\/* + [!!(varx) ==== v(9)]) *\/* + ([!!(varx) ==== v(9)] ** [!!(varx) ==== (!!(varx))] *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + [nth(find(v(0), v(10)), #3) ==== (!!(varx))])) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + [nth(find(v(0), v(11)), #3) ==== (!!(varx))]))) + ((v + :: v0 + :: v1 + :: v2 + :: ListValue l + :: v4 :: x :: x0 :: NatValue (eee varx) :: nil) ++ + x3 :: nil) (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 <<<< nth(v(4), v(8))]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x3 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x3 :: nil) + (eee, empty_heap) -> + In x3 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + length l = 4 -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )---> (#2 ++++ !!(varx)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ !!(varx)) ==== #0]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: nil) + (eee, empty_heap). +Proof. + admit. +Qed. + diff --git a/PEDANTIC/SatSolverMergeTheorem1P3.v b/PEDANTIC/SatSolverMergeTheorem1P3.v new file mode 100644 index 0000000..5591514 --- /dev/null +++ b/PEDANTIC/SatSolverMergeTheorem1P3.v @@ -0,0 +1,706 @@ +(********************************************************************************** + * The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic + * Traversal of Instruction Code) verification framework + * + * Developed by Kenneth Roe + * For more information, check out www.cs.jhu.edu/~roe + * + * TreeTraversal.v + * This file contains the proof of correctness of a tree traversal algorithm using + * the PEDANTIC verification framework. + * + **********************************************************************************) + +Require Export SfLib. +Require Export SfLibExtras. +Require Export ImpHeap. +Require Export AbsState. +Require Export AbsExecute. +Require Export AbsStateInstance. +Require Export Simplify. +Require Export Eqdep. +Require Export StateImplication. +Require Export Classical. +Require Export Unfold. +Require Export Fold. +Require Export merge. +Require Export ProgramTactics. +Require Export SatSolverDefs. +Require Export SatSolverMergeTheorem1P1. +Require Export SatSolverMergeTheorem1P2. +Opaque basicEval. + + +Theorem mergeTheorem1Aux9 : forall v v0 v1 v2 l v4 x x0 eee e, + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )---> (#2 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #2] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #1] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(#0, #4), #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8)), + #2)) (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + (forall x1 : Value, + NatValue 0 = x1 \/ + NatValue 1 = x1 \/ NatValue 2 = x1 \/ NatValue 3 = x1 \/ False -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8))]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: x1 :: nil) + (eee, empty_heap)) -> + In x0 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + NatValue 0 = nth (eee varx) l NoValue -> + e <> 0 -> + NatValue e = + (if match eee varx with + | 0 => false + | 1 => false + | 2 => false + | 3 => false + | S (S (S (S _))) => true + end + then NatValue 0 + else @NatValue unit 1) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (SUM(range(#0, #4), + (--( v(2), v(6) )---> (#2 ++++ v(8)) \\// + --( v(2), v(6) )---> (#6 ++++ v(8))) //\\ + nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0, + #1)) (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (eee, empty_heap) -> + (forall x1 : Value, + In x1 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + (((((([--( v(2), v(6) )---> (#10 ++++ v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) *\/* + [~~ --( v(2), v(6) )---> (#10 ++++ v(9))]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #0]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(9)) ==== + #0]) *\/* [v(8) ==== v(9)]) *\/* + ([!!(varx) ==== v(9)] ** [!!(varx) ==== v(8)] *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + [nth(find(v(0), v(10)), #3) ==== v(8)])) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + [nth(find(v(0), v(11)), #3) ==== v(8)])))) + ((v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) ++ + x1 :: nil) (eee, empty_heap)) -> + (forall x1 : Value, + In x1 (NatValue 0 :: NatValue 1 :: NatValue 2 :: NatValue 3 :: nil) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0] *\/* + [#0 <<<< nth(replacenth(v(4), !!(varx), !!(valuex)), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) + ((v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) ++ + x1 :: nil) (eee, empty_heap)) -> + (true = + validPredicate + (@absEval unit eq_unit (@basicEval unit) eee + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) + (#0 ==== --( v(2), v(6) )---> (#10 ++++ !!(varx))))) -> + (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap)) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + ([nth(v(4), v(6)) ==== #0] *\/* + [!!(varx) ==== v(6)] *\/* + AbsExists TreeRecords(v(0)) + ([nth(find(v(0), v(7)), #3) ==== v(6)] ** + [nth(find(v(0), v(7)), #4) ==== nth(v(4), v(6))]))) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll TreeRecords(v(0)) + ([~~ (!!(varx) ==== nth(find(v(0), v(6)), #3))])) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: nil) + (eee, empty_heap) -> + length l = 4 -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )---> (#2 ++++ !!(varx)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ !!(varx)) ==== #0]) + (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: nil) + (eee, empty_heap). +Proof. + admit. +Qed. + +Theorem mergeTheorem1 : forall bbb eee hhh, length bbb=6 -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ((AbsEmpty ** + [#0 ==== nth(v(4), !!(varx))] ** + AbsEmpty ** + [!!(stack) ==== (!!(ssss))] ** + [!!(ssss) ==== nth(v(0), #0)] ** + AbsEmpty ** + [!!(backtrack) ==== #0] ** + [v(1)] ** + AbsEmpty ** + AbsEmpty ** + AbsEmpty ** + (([!!(varx) <<<< #4] ** AbsEmpty) ** + (([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) ** AbsEmpty) ** + AbsEmpty ** + AbsAll TreeRecords(v(0)) + ([~~ (!!(varx) ==== nth(find(v(0), v(6)), #3))]) ** AbsEmpty) ** + AbsAll range(#0, #4) + ([nth(v(4), v(6)) ==== #0] *\/* + [!!(varx) ==== v(6)] *\/* + AbsExists TreeRecords(v(0)) + ([nth(find(v(0), v(7)), #3) ==== v(6)] ** + [nth(find(v(0), v(7)), #4) ==== nth(v(4), v(6))])) ** + AbsEmpty ** + AbsEmpty ** + AbsAll TreeRecords(v(2)) + (AbsExists range(#0, #4) + (([--( v(2), v(6) )---> (#2 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #2] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #1] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0])) ** + AbsAll range(#0, #4) + (([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8))]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))]) ** + AbsAll range(#0, #4) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + ([#0 <<<< --( v(2), v(6) )---> (#18 ++++ v(8))] *\/* + [nth(v(5), v(8)) ==== v(6)]) *\/* + ([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#18 ++++ v(8)) ==== #0]) ** + [~~ nth(v(5), v(8)) ==== v(6)]) ** + SUM(range(#0, #4), + #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8)), + #2) ** + (SUM(range(#0, #4), + (--( v(2), v(6) )---> (#2 ++++ v(8)) \\// + --( v(2), v(6) )---> (#6 ++++ v(8))) //\\ + nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0, + #1) ** + AbsAll range(#0, #4) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #0] *\/* + [#0 <<<< + nth(replacenth(v(4), !!(varx), !!(valuex)), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) ** + AbsAll range(#0, #4) + (AbsAll range(#0, #4) + (((((([--( v(2), v(6) )---> (#10 ++++ v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) *\/* + [~~ --( v(2), v(6) )---> (#10 ++++ v(9))]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #0]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(9)) ==== + #0]) *\/* [v(8) ==== v(9)]) *\/* + ([!!(varx) ==== v(9)] ** [!!(varx) ==== v(8)] *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + [nth(find(v(0), v(10)), #3) ==== v(8)])) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + [nth(find(v(0), v(11)), #3) ==== v(8)])))) *\/* + AbsExists range(#0, #4) + (([--( v(2), v(6) )---> (#2 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #2] *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #1]) ** + AbsAll range(#0, #4) + (([#0 ==== + nth(replacenth(v(4), !!(varx), !!(valuex)), v(9))] *\/* + [--( v(2), v(6) )---> (#10 ++++ v(9)) ==== #0] ** + [#0 <<<< + nth(replacenth(v(4), !!(varx), !!(valuex)), v(9))]) *\/* + ([!!(varx) ==== v(9)] ** + ([#0 <<<< --( v(2), v(6) )---> (#2 ++++ !!(varx))] ** + [!!(valuex) ==== #2] *\/* + [#0 <<<< --( v(2), v(6) )---> (#6 ++++ !!(varx))] ** + [!!(valuex) ==== #1]) *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + ([#0 <<<< + --( v(2), v(6) + )---> (#2 ++++ nth(find(v(0), v(10)), #3))] ** + [nth(find(v(0), v(10)), #4) ==== #2] *\/* + [#0 <<<< + --( v(2), v(6) + )---> (#6 ++++ nth(find(v(0), v(10)), #3))] ** + [nth(find(v(0), v(10)), #4) ==== #1]))) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + ([#0 <<<< + --( v(2), v(6) + )---> (#2 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #2] *\/* + [#0 <<<< + --( v(2), v(6) + )---> (#6 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #1]))))) *\/* + AbsAll range(#0, #4) + ([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #0]))))) ** + (AbsEach range(#0, #4) + (AbsExistsT + (Path(nth(v(5), v(6)), v(2), v(7), #21, #14 ++++ v(6) :: nil) ** + AbsAll TreeRecords(v(7)) + ([--( nth(v(5), v(6)), v(8) )---> (#18 ++++ v(6)) ==== #0] ** + [nth(v(5), v(6)) ==== v(7)] *\/* + [--( v(7), --( v(7), v(8) )---> (#18 ++++ v(6)) + )---> (#14 ++++ v(6)) ==== v(8)]))) ** + AbsAll TreeRecords(v(3)) + ([nth(find(v(3), !!(assignments_to_do_head)), #3) ==== #0] ** + [!!(assignments_to_do_head) ==== v(6)] *\/* + [nth(find(v(3), v(6)), #3) inTree v(3)] ** + [nth(find(v(3), nth(find(v(3), v(6)), #3)), #2) ==== v(6)]) ** + AbsAll TreeRecords(v(0)) + (AbsAll TreeRecords(nth(find(v(0), v(6)), #2)) + ([~~ + nth(find(v(0), v(6)), #3) ==== + nth(find(nth(find(v(0), v(6)), #2), v(7)), #3)])) ** + AbsAll TreeRecords(v(0)) + ([nth(v(4), nth(find(v(0), v(6)), #3)) ==== + nth(find(v(0), v(6)), #4)]) ** + AbsAll TreeRecords(v(0)) + ([nth(find(v(0), v(6)), #4) ==== #1] *\/* + [nth(find(v(0), v(6)), #4) ==== #2]) ** + AbsAll TreeRecords(v(0)) ([nth(find(v(0), v(6)), #3) <<<< #4]) ** + ARRAY(!!(watches), #4, v(5)) ** + TREE(!!(assignments_to_do_head), v(3), #4, #1 :: nil) ** + TREE(!!(clauses), v(2), #21, #1 :: nil) ** + TREE(!!(stack), v(0), #4, #1 :: nil) ** + [#1 ==== #1] ** ARRAY(!!(assignments), #4, v(4)) ** AbsEmpty) ** + build_equivs + ((!!(stack) :: (!!(ssss)) :: nth(v(0), #0) :: nil) + :: (!!(have_var) :: #1 :: nil) + :: (nth(v(4), (!!(varx))) :: (!!(backtrack)) :: #0 :: nil) :: nil)) + bbb (eee, hhh) -> + @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll TreeRecords(v(2)) + (AbsExists range(#0, #4) + (([--( v(2), v(6) )---> (#2 ++++ v(7))] ** + ([nth(v(4), v(7)) ==== #2] *\/* [nth(v(4), v(7)) ==== #0]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(7))] ** + ([nth(v(4), v(7)) ==== #1] *\/* [nth(v(4), v(7)) ==== #0])) ** + AbsAll range(#0, #4) + (([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8))]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))]) ** + AbsAll range(#0, #4) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + ([#0 <<<< --( v(2), v(6) )---> (#18 ++++ v(8))] *\/* + [nth(v(5), v(8)) ==== v(6)]) *\/* + ([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#18 ++++ v(8)) ==== #0]) ** + [~~ nth(v(5), v(8)) ==== v(6)]) ** + SUM(range(#0, #4), #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8)), + #2) ** + (SUM(range(#0, #4), + (--( v(2), v(6) )---> (#2 ++++ v(8)) \\// + --( v(2), v(6) )---> (#6 ++++ v(8))) //\\ + nth(v(4), v(8)) ==== #0, #1) ** + AbsAll range(#0, #4) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(v(4), v(8)) ==== #0] *\/* + [#0 <<<< nth(v(4), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) ** + AbsAll range(#0, #4) + (AbsAll range(#0, #4) + (((((([--( v(2), v(6) )---> (#10 ++++ v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) *\/* + [~~ --( v(2), v(6) )---> (#10 ++++ v(9))]) *\/* + [nth(v(4), v(8)) ==== #0]) *\/* + [nth(v(4), v(9)) ==== #0]) *\/* + [v(8) ==== v(9)]) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + [nth(find(v(0), v(11)), #3) ==== v(8)])))) *\/* + AbsExists range(#0, #4) + (([--( v(2), v(6) )---> (#2 ++++ v(8))] ** + [nth(v(4), v(8)) ==== #2] *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))] ** + [nth(v(4), v(8)) ==== #1]) ** + AbsAll range(#0, #4) + (([#0 ==== nth(v(4), v(9))] *\/* + [--( v(2), v(6) )---> (#10 ++++ v(9)) ==== #0] ** + [#0 <<<< nth(v(4), v(9))]) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + ([#0 <<<< + --( v(2), v(6) + )---> (#2 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #2] *\/* + [#0 <<<< + --( v(2), v(6) + )---> (#6 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #1]))))) *\/* + AbsAll range(#0, #4) + ([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [nth(v(4), v(8)) ==== #0]))))) bbb (eee,empty_heap). +Proof. + intros. + + assert(@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) (AbsAll TreeRecords(v(2)) + (AbsExists range(#0, #4) + (([--( v(2), v(6) )---> (#2 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #2] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(7))] ** + ([nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #1] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(7)) ==== #0])) ** + AbsAll range(#0, #4) + (([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8))]) *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))]) ** + AbsAll range(#0, #4) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + ([#0 <<<< --( v(2), v(6) )---> (#18 ++++ v(8))] *\/* + [nth(v(5), v(8)) ==== v(6)]) *\/* + ([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#18 ++++ v(8)) ==== #0]) ** + [~~ nth(v(5), v(8)) ==== v(6)]) ** + SUM(range(#0, #4), + #0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8)), + #2) ** + (SUM(range(#0, #4), + (--( v(2), v(6) )---> (#2 ++++ v(8)) \\// + --( v(2), v(6) )---> (#6 ++++ v(8))) //\\ + nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== #0, + #1) ** + AbsAll range(#0, #4) + ([#0 <<<< --( v(2), v(6) )---> (#10 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #0] *\/* + [#0 <<<< + nth(replacenth(v(4), !!(varx), !!(valuex)), v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) ** + AbsAll range(#0, #4) + (AbsAll range(#0, #4) + (((((([--( v(2), v(6) )---> (#10 ++++ v(8))] *\/* + [--( v(2), v(6) )---> (#2 ++++ v(8)) ==== #0] ** + [--( v(2), v(6) )---> (#6 ++++ v(8)) ==== #0]) *\/* + [~~ --( v(2), v(6) )---> (#10 ++++ v(9))]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #0]) *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(9)) ==== + #0]) *\/* [v(8) ==== v(9)]) *\/* + ([!!(varx) ==== v(9)] ** [!!(varx) ==== v(8)] *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + [nth(find(v(0), v(10)), #3) ==== v(8)])) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + [nth(find(v(0), v(11)), #3) ==== v(8)])))) *\/* + AbsExists range(#0, #4) + (([--( v(2), v(6) )---> (#2 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #2] *\/* + [--( v(2), v(6) )---> (#6 ++++ v(8))] ** + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #1]) ** + AbsAll range(#0, #4) + (([#0 ==== + nth(replacenth(v(4), !!(varx), !!(valuex)), v(9))] *\/* + [--( v(2), v(6) )---> (#10 ++++ v(9)) ==== #0] ** + [#0 <<<< + nth(replacenth(v(4), !!(varx), !!(valuex)), v(9))]) *\/* + ([!!(varx) ==== v(9)] ** + ([#0 <<<< --( v(2), v(6) )---> (#2 ++++ !!(varx))] ** + [!!(valuex) ==== #2] *\/* + [#0 <<<< --( v(2), v(6) )---> (#6 ++++ !!(varx))] ** + [!!(valuex) ==== #1]) *\/* + AbsExists TreeRecords(v(0)) + ([!!(varx) ==== v(9)] ** + ([#0 <<<< + --( v(2), v(6) + )---> (#2 ++++ nth(find(v(0), v(10)), #3))] ** + [nth(find(v(0), v(10)), #4) ==== #2] *\/* + [#0 <<<< + --( v(2), v(6) + )---> (#6 ++++ nth(find(v(0), v(10)), #3))] ** + [nth(find(v(0), v(10)), #4) ==== #1]))) *\/* + AbsExists TreeRecords(v(0)) + (AbsExists TreeRecords(find(v(0), v(10))) + ([nth(find(v(0), v(10)), #3) ==== v(9)] ** + ([#0 <<<< + --( v(2), v(6) + )---> (#2 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #2] *\/* + [#0 <<<< + --( v(2), v(6) + )---> (#6 ++++ nth(find(v(0), v(11)), #3))] ** + [nth(find(v(0), v(11)), #4) ==== #1]))))) *\/* + AbsAll range(#0, #4) + ([--( v(2), v(6) )---> (#10 ++++ v(8)) ==== #0] *\/* + [nth(replacenth(v(4), !!(varx), !!(valuex)), v(8)) ==== + #0]))))) bbb (eee,empty_heap)). + solvePickTerm H0. + + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) ([#0 ==== nth(v(4), !!(varx))]) bbb (eee,empty_heap)). solvePickTerm H0. + + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) ([!!(varx) <<<< #4]) bbb (eee,empty_heap)). solvePickTerm H0. + + destruct_bindings. simpl. + + Transparent basicEval. + destructState. + eapply RSAll. simpl. reflexivity. simpl. rewrite H6. reflexivity. + Opaque basicEval. + + intros. assert (In x rl). apply H. apply H9 in H1. clear H9. + Transparent basicEval. + destructState. hypSimp. destruct v3; inversion H7; subst; clear H7; hypSimp. Opaque basicEval. + remember (nth (eee varx) l NoValue). destruct y; inversion HeqH7; subst; clear HeqH7. + Transparent basicEval. + destruct n0; inversion H1; subst; clear H1; hypSimp. Opaque basicEval. Focus 2. elim H3. reflexivity. + + eapply RSExists. simpl. reflexivity. Transparent basicEval. simpl. reflexivity. Opaque basicEval. + eapply ex_intro. + split. apply H2. simpl. simpl in H11. simpl in H19. simpl in H17. + simpl in H9. + + Transparent basicEval. + + inversion H8; subst; clear H8. + + eapply RSCompose. + + eapply mergeTheorem1Aux5. + apply H9. apply H2. apply H7. apply H1. apply Heqy. + + + Focus 2. apply concreteComposeEmpty. split. reflexivity. reflexivity. + + eapply RSCompose. eapply RSAll. simpl. reflexivity. Transparent basicEval. reflexivity. Opaque basicEval. + intros. simpl in H8. apply H17 in H8. apply H8. + + Focus 2. apply concreteComposeEmpty. split. reflexivity. reflexivity. + + eapply RSCompose. eapply RSAll. simpl. reflexivity. Transparent basicEval. reflexivity. Opaque basicEval. + intros. simpl in H8. apply H19 in H8. apply H8. + + Focus 2. apply concreteComposeEmpty. split. reflexivity. reflexivity. + + eapply RSCompose. apply H4. + + Focus 2. apply concreteComposeEmpty. split. reflexivity. reflexivity. + + inversion H11. subst. clear H11. + + Transparent basicEval. destructState. + hypSimp. Opaque basicEval. + (*remember (beq_nat 0 match (nth (10+(eee varx)) (match (@findRecord unit (match v1 with | NatValue z => z | _ => 0 end) x) with | ListValue l => l | _ => nil end) NoValue) with | NatValue x => x | _ => 1 end).*) + remember (validPredicate (@absEval unit eq_unit (@basicEval unit) eee (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) (#0 ==== --( v(2), v(6) )---> (#10 ++++ !!varx)))). + destruct b. + + eapply RSOrComposeL. + eapply RSCompose. + + Focus 3. apply concreteComposeEmpty. split. reflexivity. reflexivity. + + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. + + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + ([nth(v(4), v(6)) ==== #0] *\/* + [!!(varx) ==== v(6)] *\/* + AbsExists TreeRecords(v(0)) + ([nth(find(v(0), v(7)), #3) ==== v(6)] ** + [nth(find(v(0), v(7)), #4) ==== nth(v(4), v(6))]))) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. + + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )--->(#2 ++++ (!!varx))====#0] ** + [--( v(2), v(6) )--->(#6 ++++ (!!varx))====#0]) + (v::v0::v1::v2::ListValue l::v4::x::nil) (eee, empty_heap)). eapply mergeTheorem1Aux9. + apply H9. apply H4. apply H17. apply H2. apply Heqy. apply H7. apply H1. apply H12. + apply H22. apply H21. apply Heqb. apply H8. apply H11. + solvePickTerm H0. + assert (exists hh, @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) (ARRAY(!!(assignments), #4, v(4))) (v::v0::v1::v2::ListValue l::v4::nil) (eee, hh)). + solvePickData H0. inversion H13. subst. clear H13. + eapply arrayLength. apply H14. simpl. reflexivity. + + eapply mergeTheorem1Aux1. apply H12. apply H21. apply Heqb. apply H8. + destruct (eee varx). simpl. reflexivity. + destruct n. reflexivity. destruct n. reflexivity. destruct n. reflexivity. + inversion H1. subst. elim H7. reflexivity. + assert (exists hh, @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) (ARRAY(!!(assignments), #4, v(4))) (v::v0::v1::v2::ListValue l::v4::nil) (eee, hh)). + solvePickData H0. inversion H14. subst. clear H14. + eapply arrayLength. apply H15. simpl. reflexivity. + apply Heqy. apply H13. + + eapply RSCompose. + Focus 3. apply concreteComposeEmpty. split. reflexivity. reflexivity. + + eapply RSAll. simpl. reflexivity. Transparent basicEval. simpl. reflexivity. Opaque basicEval. intros. eapply H21 in H8. + + simpl. eapply mergeTheorem1Aux2. apply Heqb. apply H8. apply Heqy. + + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. apply H11. + assert (exists hh, @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) (ARRAY(!!(assignments), #4, v(4))) (v::v0::v1::v2::ListValue l::v4::nil) (eee, hh)). + solvePickData H0. inversion H11. subst. clear H11. + eapply arrayLength. apply H13. simpl. reflexivity. + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([--( v(2), v(6) )--->(#2 ++++ (!!varx))====#0] ** + [--( v(2), v(6) )--->(#6 ++++ (!!varx))====#0]) + (v::v0::v1::v2::ListValue l::v4::x::nil) (eee, empty_heap)). eapply mergeTheorem1Aux9. + apply H9. apply H4. apply H17. apply H2. apply Heqy. apply H7. apply H1. apply H12. + apply H22. apply H21. apply Heqb. + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. + apply H11. + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll range(#0, #4) + ([nth(v(4), v(6)) ==== #0] *\/* + [!!(varx) ==== v(6)] *\/* + AbsExists TreeRecords(v(0)) + ([nth(find(v(0), v(7)), #3) ==== v(6)] ** + [nth(find(v(0), v(7)), #4) ==== nth(v(4), v(6))]))) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. + apply H11. + solvePickTerm H0. + assert (exists hh, @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) (ARRAY(!!(assignments), #4, v(4))) (v::v0::v1::v2::ListValue l::v4::nil) (eee, hh)). + solvePickData H0. inversion H11. subst. clear H11. + eapply arrayLength. apply H13. simpl. reflexivity. +apply H11. + + + eapply RSAll. simpl. reflexivity. Transparent basicEval. simpl. reflexivity. Opaque basicEval. intros. eapply H22 in H8. clear H22. + + inversion H8. subst. clear H8. Transparent basicEval. simpl in H15. inversion H15. subst. clear H15. + Opaque basicEval. simpl in H20. + eapply RSAll. simpl. reflexivity. Transparent basicEval. reflexivity. Opaque basicEval. intros. simpl in H8. eapply H20 in H8. clear H20. simpl. + + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. + + eapply mergeTheorem1Aux3. + destruct (eee varx). reflexivity. destruct n. reflexivity. destruct n. reflexivity. + destruct n. reflexivity. inversion H1. subst. elim H7. reflexivity. + apply Heqy. apply Heqb. apply H8. + assert (exists hh, @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) (ARRAY(!!(assignments), #4, v(4))) (v::v0::v1::v2::ListValue l::v4::nil) (eee, hh)). + solvePickData H0. inversion H13. subst. clear H13. + eapply arrayLength. apply H14. simpl. reflexivity. + apply H11. + + eapply RSOrComposeR. eapply RSOrComposeR. + + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. + + eapply mergeTheorem1Aux4. + apply H4. + simpl. apply H17. + apply H2. + destruct (eee varx). reflexivity. destruct n. reflexivity. destruct n. reflexivity. + destruct n. reflexivity. inversion H1. subst. clear H1. elim H7. reflexivity. + apply Heqy. apply H12. apply H22. apply H21. apply Heqb. apply H8. + assert (exists hh, @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) (ARRAY(!!(assignments), #4, v(4))) (v::v0::v1::v2::ListValue l::v4::nil) (eee, hh)). + solvePickData H0. inversion H11. subst. clear H11. + eapply arrayLength. apply H13. simpl. reflexivity. + + subst. clear H11. + + inversion H15. subst. clear H15. + + eapply RSOrComposeR. + + remember (@mapSum unit eq_unit (@basicEval unit) eee (v :: v0 :: v1 :: v2 :: ListValue l :: v4 :: x :: x0 :: nil) (NatValue 0::NatValue 1::NatValue 2::NatValue 3::nil) + ((--( v(2), v(6) )---> (#2 ++++ v(8)) //\\ nth(v(4), v(8)) ==== #2) \\// + (--( v(2), v(6) )---> (#6 ++++ v(8)) //\\ nth(v(4), v(8)) ==== #1))). + + destruct n. + + eapply RSOrComposeR. + + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. + + eapply mergeTheorem1Aux7. + apply H9. apply H4. apply H17. apply H2. apply Heqy. apply H7. apply H1. apply H14. + apply Heqn. apply H8. + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll TreeRecords(v(0)) ([nth(find(v(0), v(6)), #3) <<<< #4])) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. + simpl. + eapply dumpVar2. instantiate (2 := 6). Focus 2. simpl. reflexivity. Focus 2. simpl. + reflexivity. simpl. + eapply dumpVar2. instantiate (2 := 6). Focus 2. simpl. reflexivity. Focus 2. simpl. + reflexivity. simpl. + inversion H11. subst. clear H11. + Transparent basicEval. simpl in H16. Opaque basicEval. + eapply RSAll. Transparent basicEval. simpl. reflexivity. apply H16. + intros. apply H21 in H11. simpl in H11. simpl. apply H11. + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + (AbsAll TreeRecords(v(0)) + ([nth(v(4), nth(find(v(0), v(6)), #3)) ==== + nth(find(v(0), v(6)), #4)])) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. + simpl. + eapply dumpVar2. instantiate (2 := 6). Focus 2. simpl. reflexivity. Focus 2. simpl. + reflexivity. simpl. + eapply dumpVar2. instantiate (2 := 6). Focus 2. simpl. reflexivity. Focus 2. simpl. + reflexivity. simpl. + inversion H11. subst. clear H11. + Transparent basicEval. simpl in H16. Opaque basicEval. + eapply RSAll. Transparent basicEval. simpl. reflexivity. apply H16. + intros. apply H21 in H11. simpl in H11. simpl. apply H11. + + eapply RSOrComposeL. + + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. + + eapply mergeTheorem1Aux8. + apply H9. apply H4. apply H17. apply H2. apply Heqy. apply H7. apply H1. apply H14. + apply Heqn. apply H8. + + eapply RSOrComposeR. eapply RSOrComposeR. + subst. clear H15. + assert (@realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) + ([!!(valuex) ==== #1] *\/* [!!(valuex) ==== #2]) + (v::v0::v1::v2::ListValue l::v4::nil) (eee, empty_heap)). solvePickTerm H0. + + eapply mergeTheorem1Aux6. + apply H2. apply H7. apply H1. apply Heqy. apply H14. apply H8. + assert (exists hh, @realizeState unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit (@basicEval unit)) (ARRAY(!!(assignments), #4, v(4))) (v::v0::v1::v2::ListValue l::v4::nil) (eee, hh)). + solvePickData H0. inversion H11. subst. clear H11. + eapply arrayLength. apply H12. simpl. reflexivity. +Qed. + diff --git a/PEDANTIC/Simplify.v b/PEDANTIC/Simplify.v index 42aad2e..f647cba 100644 --- a/PEDANTIC/Simplify.v +++ b/PEDANTIC/Simplify.v @@ -28,36 +28,46 @@ Require Export Coq.Logic.FunctionalExtensionality. Require Export Eqdep. Require Export AbsExecute. Require Export PickElement. -Opaque unitEval. -Inductive Context {ev} {eq} {f} {t} {ac} := - | StateComponent : @absState ev eq f t ac -> @Context ev eq f t ac - | AllContext : @absExp ev eq f -> @Context ev eq f t ac -> @Context ev eq f t ac - | NonZeroExpression : @absExp ev eq f -> @Context ev eq f t ac - | Domain : nat -> @absExp ev eq f -> @Context ev eq f t ac. +Inductive Context := + | StateComponent : absState -> Context + | AllContext : absExp -> Context -> Context + | NonZeroExpression : absExp -> Context + | Domain : nat -> absExp -> Context. -Fixpoint buildExpressionContext {ev} {eq} {f} {t} {ac} (e: @absExp ev eq f) (neg : bool) : list (@Context ev eq f t ac) := +Fixpoint pushContext (c : Context) := + match c with + | StateComponent s => StateComponent (addStateVar 0 s) + | AllContext e c => AllContext (addExpVar 0 e) (pushContext c) + | NonZeroExpression e => NonZeroExpression (addExpVar 0 e) + | Domain n e => Domain (S n) (addExpVar 0 e) + end. + +Fixpoint pushContextList (c : list Context) := + map pushContext c. + +Fixpoint buildExpressionContext (e: absExp) (neg : bool) : list Context := if neg then match e with - | AbsFun (AbsOrId) (p::q::nil) => (@buildExpressionContext ev eq f t ac p true)++(@buildExpressionContext ev eq f t ac q true) - | AbsFun (AbsImplyId) (p::q::nil) => (@buildExpressionContext ev eq f t ac p false)++(@buildExpressionContext ev eq f t ac q true) + | AbsFun (AbsOrId) (p::q::nil) => (buildExpressionContext p true)++(buildExpressionContext q true) + | AbsFun (AbsImplyId) (p::q::nil) => (buildExpressionContext p false)++(buildExpressionContext q true) | ~~e => ((NonZeroExpression e)::nil) | _ => ((NonZeroExpression (~~e))::nil) end else match e with - | AbsFun (AbsAndId) (p::q::nil) => (@buildExpressionContext ev eq f t ac p false)++(@buildExpressionContext ev eq f t ac q false) + | AbsFun (AbsAndId) (p::q::nil) => (buildExpressionContext p false)++(buildExpressionContext q false) | _ => ((NonZeroExpression e)::nil) end. -Fixpoint buildNegStateContext {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : list (@Context ev eq f t ac) := +Fixpoint buildNegStateContext (s : absState) : list Context := match s with | AbsOrStar l r => (buildNegStateContext l)++(buildNegStateContext r) | AbsLeaf (AbsPredicate) (x::nil) => buildExpressionContext x true | _ => nil end. -Fixpoint buildStateContext {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : list (@Context ev eq f t ac) := +Fixpoint buildStateContext (s : absState) : list Context := match s with | AbsStar l r => (buildStateContext l)++(buildStateContext r) | AbsLeaf (AbsPredicate) (x::nil) => buildExpressionContext x false @@ -65,21 +75,21 @@ Fixpoint buildStateContext {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : | _ => (StateComponent s)::nil end. -Fixpoint enterAll {ev} {eq} {f} {t} {ac} (e : @absExp ev eq f) (context : list (@Context ev eq f t ac)) := +Fixpoint enterAll (e : absExp) (context : list Context) := match context with | nil => nil | ((AllContext ee cc)::r) => if beq_absExp ee e then cc::(enterAll e r) else enterAll e r - | (f::r) => f::(enterAll e r) + | (f::r) => (pushContext f)::(enterAll e r) end. -Fixpoint enterQuant {ev} {eq} {f} {t} {ac} (context : list (@Context ev eq f t ac)) := +Fixpoint enterQuant (context : list Context) := match context with | nil => nil | ((AllContext ee cc)::r) => enterQuant r - | (f::r) => f::(enterQuant r) + | (f::r) => (pushContext f)::(enterQuant r) end. -Fixpoint findMember {ev} {eq} {f} (base : @absExp ev eq f) (context : list absExp) := +Fixpoint findMember (base : absExp) (context : list absExp) := match context with | (AbsFun (AbsMemberId) (element::tree))::r => if beq_absExp base element then Some tree @@ -88,7 +98,7 @@ Fixpoint findMember {ev} {eq} {f} (base : @absExp ev eq f) (context : list absEx | nil => None end. -Fixpoint hasCell {ev} {eq} {f} {t} {ac} (state : @absState ev eq f t ac) (loc : @absExp ev eq f) := +Fixpoint hasCell (state : absState) (loc : absExp) := match state with | AbsLeaf (Id 3) (*AbsCellId*) (l::v::nil) => beq_absExp l loc | AbsExistsT s => hasCell s loc @@ -99,7 +109,7 @@ Fixpoint hasCell {ev} {eq} {f} {t} {ac} (state : @absState ev eq f t ac) (loc : | _ => false end. -Fixpoint findSmallerVar {ev} {eq} {f} {t} {ac} (v : id) (c : list (@Context ev eq f t ac)) : @absExp ev eq f := +Fixpoint findSmallerVar (v : id) (c : list Context) : absExp := match c with | (NonZeroExpression ((AbsVar x)====(AbsConstVal z))::r) => if beq_id x v then (AbsConstVal z) else findSmallerVar v r | (NonZeroExpression ((AbsConstVal z)====(AbsVar x))::r) => if beq_id x v then (AbsConstVal z) else findSmallerVar v r @@ -113,7 +123,7 @@ Fixpoint findSmallerVar {ev} {eq} {f} {t} {ac} (v : id) (c : list (@Context ev e | _ => AbsVar v end. -Fixpoint findVar {ev} {eq} {f} {t} {ac} (e : @absExp ev eq f) (c : list (@Context ev eq f t ac)) : @absExp ev eq f := +Fixpoint findVar (e : absExp) (c : list Context) : absExp := match c with | (NonZeroExpression ((AbsVar x)====xx)::r) => if beq_absExp xx e then (AbsVar x) else findVar e r | (NonZeroExpression (xx====(AbsVar x))::r) => if beq_absExp xx e then (AbsVar x) else findVar e r @@ -121,7 +131,7 @@ Fixpoint findVar {ev} {eq} {f} {t} {ac} (e : @absExp ev eq f) (c : list (@Contex | _ => e end. -Fixpoint findVarSubst {ev} {eq} {f} {t} {ac} (vv: id) (c : list (@Context ev eq f t ac)) : @absExp ev eq f := +Fixpoint findVarSubst (vv: id) (c : list Context) : absExp := match c with | (NonZeroExpression ((AbsVar x)====#c)::r) => if beq_id x vv then #c else (AbsVar vv) | (NonZeroExpression (#c====(AbsVar x))::r) => if beq_id x vv then #c else (AbsVar vv) @@ -129,26 +139,29 @@ Fixpoint findVarSubst {ev} {eq} {f} {t} {ac} (vv: id) (c : list (@Context ev eq | _ => (AbsVar vv) end. -Fixpoint noBiggerQuantVars {ev} {eq} {f} (n : nat) (e : @absExp ev eq f) : bool := +Fixpoint noSmallerQuantVars (n : nat) (e : absExp) : bool := match e with | AbsVar _ => true - | AbsQVar x => if ble_nat n x then false else true + | AbsQVar x => if ble_nat x n then false else true | AbsConstVal _ => true | AbsFun i l => (fix go l := match l with | nil => true - | (f::r) => if noBiggerQuantVars n f then go r else false + | (f::r) => if noSmallerQuantVars n f then go r else false end) l end. -Fixpoint subQVar {ev} {eq} {f} {t} {ac} (v : nat) (c : list (@Context ev eq f t ac)) : @absExp ev eq f := +Fixpoint subQVar (v : nat) (c : list Context) : absExp := match c with - | (NonZeroExpression ((AbsQVar x)====y)::r) => if beq_nat v x then (if noBiggerQuantVars x y then y else subQVar v r) else subQVar v r - | (NonZeroExpression (y====(AbsQVar x))::r) => if beq_nat v x then (if noBiggerQuantVars x y then y else subQVar v r) else subQVar v r + | (NonZeroExpression ((AbsQVar x)====y)::r) => if beq_nat v x then (if noSmallerQuantVars x y then y else subQVar v r) else (match y with + | AbsQVar zz => if beq_nat zz v then (if ble_nat zz x then AbsQVar x else subQVar v r) else subQVar v r + | _ => subQVar v r + end) + | (NonZeroExpression (y====(AbsQVar x))::r) => if beq_nat v x then (if noSmallerQuantVars x y then y else subQVar v r) else subQVar v r | (_::r) => subQVar v r | _ => AbsQVar v end. -Fixpoint pickCt {ev} {eq} {f} {t} {ac} (x : @absExp ev eq f) (context : list (@Context ev eq f t ac)) : bool := +Fixpoint pickCt (x : absExp) (context : list Context) : bool := match context with | nil => false | ((StateComponent (l |-> f))::r) => if beq_absExp x f then true else pickCt x r @@ -156,7 +169,7 @@ Fixpoint pickCt {ev} {eq} {f} {t} {ac} (x : @absExp ev eq f) (context : list (@C | (_::r) => pickCt x r end. -Fixpoint pickRt {ev} {eq} {f} {t} {ac} (x : @absExp ev eq f) (context : list (@Context ev eq f t ac)) : bool := +Fixpoint pickRt (x : absExp) (context : list Context) : bool := match context with | nil => false | ((StateComponent ((l++++#0) |-> f))::r) => if beq_absExp x f then true @@ -170,20 +183,21 @@ Fixpoint pickRt {ev} {eq} {f} {t} {ac} (x : @absExp ev eq f) (context : list (@C | (_::r) => pickRt x r end. -Fixpoint allPresent {ev} {eq} {f} {t} {ac} (l : list (@absExp ev eq f)) (e: @absExp ev eq f) (context : list (@Context ev eq f t ac)) : bool := +Fixpoint allPresent (l : list absExp) (e: absExp) (context : list Context) : bool := match l with | nil => true | ((AbsVar x)::r) => allPresent r e context | (x::r) => if beq_absExp e x then allPresent r e context else if pickCt x context then allPresent r e context else false end. -Fixpoint allUsed {ev} {eq} {f} {t} {ac} (l : list (@absExp ev eq f)) (e: @absExp ev eq f) (context : list (@Context ev eq f t ac)) : bool := +Fixpoint allUsed (l : list absExp) (e: absExp) (context : list Context) : bool := match l with | nil => true + | ((!!v)::r) => allUsed r e context | (x::r) => if beq_absExp e x then allUsed r e context else if pickRt x context then allUsed r e context else false end. -Fixpoint findDomain {ev} {eq} {f} {t} {ac} (n : nat) (context : list (@Context ev eq f t ac)) := +Fixpoint findDomain (n : nat) (context : list Context) := match context with | nil => None | ((Domain v (AbsFun (AbsRangeSetId) (d::nil)))::r) => if beq_nat v n then Some d else findDomain n r @@ -206,7 +220,7 @@ Fixpoint findDomain {ev} {eq} {f} {t} {ac} (n : nat) (context : list (@Context e | nil => None end.*) -Fixpoint hasEquality {ev} {eq} {f} {t} {ac} (c : list (@Context ev eq f t ac)) (e1: @absExp ev eq f) (e2: @absExp ev eq f) := +Fixpoint hasEquality (c : list Context) (e1: absExp) (e2: absExp) := match c with | nil => false | ((NonZeroExpression (AbsFun (AbsEqualId) (l::r::nil)))::rest) => @@ -215,7 +229,7 @@ Fixpoint hasEquality {ev} {eq} {f} {t} {ac} (c : list (@Context ev eq f t ac)) ( | (_::r) => hasEquality r e1 e2 end. -Fixpoint hasNonZero {ev} {eq} {f} {t} {ac} (c : list (@Context ev eq f t ac)) (e: @absExp ev eq f) := +Fixpoint hasNonZero (c : list Context) (e: absExp) := match c with | nil => false | ((NonZeroExpression x)::rest) => @@ -224,51 +238,48 @@ Fixpoint hasNonZero {ev} {eq} {f} {t} {ac} (c : list (@Context ev eq f t ac)) (e | (_::r) => hasNonZero r e end. -Fixpoint simplifyExp {ev:Type} {eq: ev -> ev -> bool} - {f:id -> list (@Value ev) -> (@Value ev)} - {t} {ac} - (rule : (list (@Context ev eq f t ac)) - -> nat -> (@absExp ev eq f) -> (@absExp ev eq f)) - (context : list (@Context ev eq f t ac)) - (n :nat) - (e : @absExp ev eq f) : @absExp ev eq f := - rule context n (match e with +Fixpoint simplifyExp + (rule : (list Context) + -> absExp -> absExp) + (context : list Context) + (e : absExp) : absExp := + rule context (match e with | AbsFun (AbsImplyId) (p::q::nil) => - match @simplifyExp ev eq f t ac rule - ((buildExpressionContext q true)++context) n p with + match simplifyExp rule + ((buildExpressionContext q true)++context) p with | #0 => #1 - | #x => @simplifyExp ev eq f t ac rule context n q - | x => x -->> (@simplifyExp ev eq f t ac rule - ((buildExpressionContext x false)++context) n q) + | #x => simplifyExp rule context q + | x => x -->> (simplifyExp rule + ((buildExpressionContext x false)++context) q) end | AbsFun (AbsAndId) (p::q::nil) => - match @simplifyExp ev eq f t ac rule - ((buildExpressionContext q false)++context) n p with + match simplifyExp rule + ((buildExpressionContext q false)++context) p with | #0 => #0 - | #x => @simplifyExp ev eq f t ac rule context n q - | x => x //\\ (@simplifyExp ev eq f t ac rule - ((buildExpressionContext x false)++context) n q) + | #x => simplifyExp rule context q + | x => x //\\ (simplifyExp rule + ((buildExpressionContext x false)++context) q) end | AbsFun (AbsOrId) (p::q::nil) => - match @simplifyExp ev eq f t ac rule - ((buildExpressionContext q true)++context) n p with - | #0 => @simplifyExp ev eq f t ac rule context n q + match simplifyExp rule + ((buildExpressionContext q true)++context) p with + | #0 => simplifyExp rule context q | #x => #x - | x => x \\// (@simplifyExp ev eq f t ac rule - ((buildExpressionContext x true)++context) n q) + | x => x \\// (simplifyExp rule + ((buildExpressionContext x true)++context) q) end | AbsFun (AbsIteId) (p::q::r::nil) => - match (@simplifyExp ev eq f t ac rule context n p) with + match (simplifyExp rule context p) with | #x => if beq_nat x 0 - then (@simplifyExp ev eq f t ac rule context n r) - else (@simplifyExp ev eq f t ac rule context n q) + then (simplifyExp rule context r) + else (simplifyExp rule context q) | x => (AbsFun (AbsIteId) - (x::(@simplifyExp ev eq f t ac rule - ((buildExpressionContext x false)++context) n q):: - (@simplifyExp ev eq f t ac rule - ((buildExpressionContext x true)++context) n r)::nil)) + (x::(simplifyExp rule + ((buildExpressionContext x false)++context) q):: + (simplifyExp rule + ((buildExpressionContext x true)++context) r)::nil)) end - | AbsFun i l => (AbsFun i (map (@simplifyExp ev eq f t ac rule context n) l)) + | AbsFun i l => (AbsFun i (map (simplifyExp rule context) l)) | x => x end). @@ -287,8 +298,8 @@ Fixpoint simplifyExp {ev:Type} {eq: ev -> ev -> bool} | x => AbsFun (AbsNthId) (p::q::nil) end.*) -Fixpoint findArray {ev:Type} {eq} {f} {t} {ac} (context : list (@Context ev eq f t ac)) - (base : @absExp ev eq f) := +Fixpoint findArray (context : list Context) + (base : absExp) := match context with | nil => None | ((StateComponent (ARRAY(_,size,b)))::r) => if beq_absExp b base then @@ -296,8 +307,8 @@ Fixpoint findArray {ev:Type} {eq} {f} {t} {ac} (context : list (@Context ev eq f | (_::r) => findArray r base end. -Fixpoint findLess {ev:Type} {eq} {f} {t} {ac} (context : list (@Context ev eq f t ac)) - (loc : @absExp ev eq f) (size : @absExp ev eq f) : bool := +Fixpoint findLess (context : list Context) + (loc : absExp) (size : absExp) : bool := match context with | nil => false | (NonZeroExpression (l <<<< s)::r) => if beq_absExp l loc then if beq_absExp s size then true @@ -305,31 +316,31 @@ Fixpoint findLess {ev:Type} {eq} {f} {t} {ac} (context : list (@Context ev eq f | (_::r) => findLess r loc size end. -Fixpoint validReplace {ev:Type} {eq} {f} {t} {ac} (context : list (@Context ev eq f t ac)) - (base : @absExp ev eq f) (loc : @absExp ev eq f) : bool := +Fixpoint validReplace (context : list Context) + (base : absExp) (loc : absExp) : bool := match findArray context base with | Some size => findLess context loc size | None => false end. -Fixpoint rangeBotExclude {ev:Type} {eq} {f} (n:nat) (s:@absExp ev eq f) (e:@absExp ev eq f) - (v1:@absExp ev eq f) (v2:@absExp ev eq f) := +Fixpoint rangeBotExclude (n:nat) (s:absExp) (e:absExp) + (v1:absExp) (v2:absExp) := match v1 with | AbsQVar m => if beq_nat (S m) n then if beq_absExp (v2++++#1) s then true else false else false | _ => false end. -Fixpoint rangeExclude {ev:Type} {eq} {f} (n:nat) (s:@absExp ev eq f) (e:@absExp ev eq f) - (v1:@absExp ev eq f) (v2:@absExp ev eq f) := +Fixpoint rangeExclude (n:nat) (s:absExp) (e:absExp) + (v1:absExp) (v2:absExp) := match v1 with | AbsQVar m => if beq_nat (S m) n then if beq_absExp v2 e then true else rangeBotExclude n s e v1 v2 else rangeBotExclude n s e v1 v2 | _ => rangeBotExclude n s e v1 v2 end. -Fixpoint notEqual {ev:Type} {eq} {f} {t} {ac} (context : list (@Context ev eq f t ac)) - (e1 : @absExp ev eq f) (e2 : @absExp ev eq f) : bool := +Fixpoint notEqual (context : list Context) + (e1 : absExp) (e2 : absExp) : bool := match context with | (NonZeroExpression (~~(l====r))::rest) => match beq_absExp e1 l,beq_absExp e2 r with | true,true => true @@ -344,7 +355,7 @@ Fixpoint notEqual {ev:Type} {eq} {f} {t} {ac} (context : list (@Context ev eq f | nil => false end. -Fixpoint boolExp {ev} {eq} {f} (e : @absExp ev eq f) := +Fixpoint boolExp (e : absExp) := match e with | ~~x => true | a====b => true @@ -352,7 +363,7 @@ Fixpoint boolExp {ev} {eq} {f} (e : @absExp ev eq f) := | _ => false end. -Fixpoint inversionExp {ev} {eq} {f} (a : @absExp ev eq f) (b : @absExp ev eq f) := +Fixpoint inversionExp (a : absExp) (b : absExp) := match a,b with | x,~~y => beq_absExp x y | ~~x,y => beq_absExp x y @@ -361,15 +372,15 @@ Fixpoint inversionExp {ev} {eq} {f} (a : @absExp ev eq f) (b : @absExp ev eq f) | _,_ => false end. -Fixpoint basicExpRule1 {ev:Type} {eq} {f} {t} {ac} - (context : list (@Context ev eq f t ac)) - (n : nat) (e : @absExp ev eq f) : @absExp ev eq f := +Fixpoint basicExpRule1 + (context : list Context) + (e : absExp) : absExp := match e with | AbsFun (AbsEqualId) ((#a)::(#b)::nil) => if beq_nat a b then (#1) else (#0) | AbsFun (AbsEqualId) ((#0)::(a++++b)::nil) => ((#0====a) //\\ (#0====b)) | AbsFun (AbsEqualId) ((#a)::(exp++++(#b))::nil) => if ble_nat b a then (#(a-b)====exp) else e | AbsFun (AbsEqualId) (e1::e2::nil) => if (beq_absExp e1 e2) - then @AbsConstVal ev eq f (NatValue 1) + then AbsConstVal (NatValue 1) else if hasEquality context e1 e2 then (#1) else if hasNonZero context (e1<<< if beq_id ff AbsListId then match x with - | NatValue n => nth n l (@AbsConstVal ev eq f NoValue) - | _ => (@AbsConstVal ev eq f NoValue) + | NatValue n => nth n l (AbsConstVal NoValue) + | _ => (AbsConstVal NoValue) end else (AbsFun (AbsNthId) (p::q::nil)) | _,a => (AbsFun (AbsNthId) (p::q::nil)) @@ -443,7 +454,7 @@ Fixpoint basicExpRule1 {ev:Type} {eq} {f} {t} {ac} | AbsFun (AbsFindId) ((AbsFun (AbsListId) (ff::r))::f'::nil) => if beq_absExp ff f' then AbsFun (AbsListId) (ff::r) else match f' with - | AbsQVar m => match findDomain (m+1) context with + | AbsQVar m => match findDomain m context with | Some d => if allUsed r d context then (AbsFun (AbsFindId) (d::f'::nil)) else @@ -453,7 +464,7 @@ Fixpoint basicExpRule1 {ev:Type} {eq} {f} {t} {ac} | _ => (AbsFun (AbsFindId) ((AbsFun (AbsListId) (ff::r))::f'::nil)) end | AbsFun (AbsFindId) ((AbsFun (AbsFindId) (base::(AbsQVar v1)::nil))::(AbsQVar v2)::nil) => - match findDomain (v2+1) context,findDomain (v1+1) context with + match findDomain v2 context,findDomain v1 context with | Some (AbsFun (AbsFindId) (base::(AbsQVar v1)::nil)), Some b2 => if beq_absExp base b2 then (AbsFun (AbsFindId) (base::(AbsQVar v2)::nil)) else e @@ -471,9 +482,9 @@ Fixpoint basicExpRule1 {ev:Type} {eq} {f} {t} {ac} | x => x end. -Fixpoint simplifyExpression {ev:Type} {eq} {f} {t} {ac} (context : list (@Context ev eq f t ac)) (n : nat) - (e : @absExp ev eq f) := - @simplifyExp ev eq f t ac basicExpRule1 context n e. +Fixpoint simplifyExpression (context : list Context) + (e : absExp) := + simplifyExp basicExpRule1 context e. (* @simplifyExp ev eq f t ac (fun c n e => (findVar (basicExpRule1 c n e) c)) context n e.*) (* @@ -580,13 +591,13 @@ Fixpoint simplifyExpression {ev:Type} {eq} {f} {t} {ac} (context : list (@Contex | AbsFun i l => findVar (AbsFun i (map (@simplifyExpression ev eq f t ac context n) l)) context end.*) -Fixpoint eliminatedQuantVar {ev} {eq} {f} {t} {ac} (v : nat) (s : @absState ev eq f t ac) : bool := +Fixpoint eliminatedQuantVar (v : nat) (s : absState) : bool := match s with - | AbsStar x y => if @eliminatedQuantVar ev eq f t ac v x then @eliminatedQuantVar ev eq f t ac v y + | AbsStar x y => if eliminatedQuantVar v x then eliminatedQuantVar v y else false - | [v(n)====e] => if beq_nat n v then (if noBiggerQuantVars n e then true else false) else + | [v(n)====e] => if beq_nat n v then (if noSmallerQuantVars n e then true else false) else (if hasVnExp e v then false else true) - | [e====v(n)] => if beq_nat n v then (if noBiggerQuantVars n e then true else false) else + | [e====v(n)] => if beq_nat n v then (if noSmallerQuantVars n e then true else false) else (if hasVnExp e v then false else true) | x => if hasVnState x v then false else true end. @@ -624,7 +635,7 @@ Ltac solveSimplifyExistsPPP := (eapply SEEliminateT;simpl;reflexivity) ]. *) -Fixpoint reduceFieldRef {ev} {eq} {f} (n : nat ) (e : @absExp ev eq f) : option (absExp * list absExp) := +Fixpoint reduceFieldRef (n : nat ) (e : absExp) : option (absExp * list absExp) := match e with | AbsFun (AbsFindId) ((AbsFun (AbsListId) (f::l))::(AbsQVar x)::nil) => if beq_nat x n then @@ -632,7 +643,7 @@ Fixpoint reduceFieldRef {ev} {eq} {f} (n : nat ) (e : @absExp ev eq f) : option else None | AbsFun i l => match (fix go l := match l with - | (ff::r) => match @reduceFieldRef ev eq f n ff with + | (ff::r) => match reduceFieldRef n ff with | Some (a,b) => Some ((a::r),b) | None => match go r with | Some (a,b) => Some (ff::a,b) @@ -647,7 +658,7 @@ Fixpoint reduceFieldRef {ev} {eq} {f} (n : nat ) (e : @absExp ev eq f) : option | x => None end. -Fixpoint pickAssignment {ev} {eq} {f} {t} {ac} (n : nat) (s : @absState ev eq f t ac) : option ((@absState ev eq f t ac) * (@absExp ev eq f)) := +Fixpoint pickAssignment (n : nat) (s : absState) : option (absState * absExp) := match s with | AbsStar l r => match pickAssignment n l with | Some (s',e) => Some ((AbsStar s' r),e) @@ -656,27 +667,35 @@ Fixpoint pickAssignment {ev} {eq} {f} {t} {ac} (n : nat) (s : @absState ev eq f | None => None end end - | AbsExists l s => match pickAssignment n s with - | Some (s',e) => Some ((AbsExists l s'),e) + | AbsMagicWand l r => match pickAssignment n l with + | Some (s',e) => Some ((AbsMagicWand s' r),e) + | None => None + end + | AbsExists l s => match pickAssignment (S n) s with + | Some (s',e) => Some ((AbsExists l s'),(removeExpVar 0 e)) | None => None end - | AbsExistsT s => match pickAssignment n s with - | Some (s',e) => Some ((AbsExistsT s'),e) + | AbsExistsT s => match pickAssignment (S n) s with + | Some (s',e) => Some ((AbsExistsT s'),(removeExpVar 0 e)) | None => None end - | [v(x)====e] => if beq_nat x n then if noBiggerQuantVars x e then Some (AbsEmpty,e) else None else None - | [e====v(x)] => if beq_nat x n then if noBiggerQuantVars x e then Some (AbsEmpty,e) else None else None + | [v(x)====e] => if beq_nat x n then if noSmallerQuantVars x e then Some (AbsEmpty,e) else None else + match e with + | v(y) => if beq_nat y n then if ble_nat y x then Some (AbsEmpty,v(x)) else None else None + | _ => None + end + | [e====v(x)] => if beq_nat x n then if noSmallerQuantVars x e then Some (AbsEmpty,e) else None else None | _ => None end. -Fixpoint pickC {ev} {eq} {f} {t} {ac} (x : @absExp ev eq f) (context : list (@Context ev eq f t ac)) : bool := +Fixpoint pickC (x : absExp) (context : list Context) : bool := match context with | nil => false | ((StateComponent (l |-> f))::r) => if beq_absExp x f then true else pickC x r | (_::r) => pickC x r end. -Fixpoint pickPred {ev} {eq} {f} {t} {ac} (x : @absExp ev eq f) (context : list (@Context ev eq f t ac)) : bool := +Fixpoint pickPred (x : absExp) (context : list Context) : bool := match context with | nil => false | ((StateComponent ([p]))::r) => if beq_absExp x p then true else pickPred x r @@ -684,60 +703,64 @@ Fixpoint pickPred {ev} {eq} {f} {t} {ac} (x : @absExp ev eq f) (context : list ( | (_::r) => pickPred x r end. -Definition unfoldAll {ev} {eq} {f} {t} {ac} (v : @absExp ev eq f) (s : @absState ev eq f t ac) (n : nat) := +Definition unfoldAll (v : absExp) (s : absState) (n : nat) := match v with | (AbsFun (AbsListId) (ff::l)) => fold_left (fun x y => (AbsStar x y)) (map (fun x => (AbsAll (TreeRecords(x)) s)) l) - (removeStateVar n (replaceStateVar n ff s)) + (removeStateVar 0 (replaceStateVar 0 (addExpVar 0 ff) s)) | v' => AbsAll (TreeRecords(v')) s end. -Definition unfoldExists {ev} {eq} {f} {t} {ac} (v : @absExp ev eq f) (s : @absState ev eq f t ac) (n : nat) := +Definition unfoldExists (v : absExp) (s : absState) (n : nat) := match v with | (AbsFun (AbsListId) (ff::l)) => fold_left (fun x y => (AbsOrStar x y)) (map (fun x => (AbsExists (TreeRecords(x)) s)) l) - (removeStateVar n (replaceStateVar n ff s)) + (removeStateVar 0 (replaceStateVar 0 (addExpVar 0 ff) s)) | v' => AbsExists (TreeRecords(v')) s end. -Definition equalsNil {ev} {eq} {f} x := x====(@AbsConstVal ev eq f (ListValue nil)). - -Fixpoint simplifySt {ev} {eq} {f} {t} {ac} - (erule : (list (@Context ev eq f t ac)) - -> nat -> (@absExp ev eq f) -> (@absExp ev eq f)) - (rule : nat -> list (@Context ev eq f t ac) -> (@absState ev eq f t ac) -> - (@absState ev eq f t ac)) - (n : nat) - (context : list (@Context ev eq f t ac)) - (s : @absState ev eq f t ac) : @absState ev eq f t ac := - rule n context +Definition equalsNil x := x====(@AbsConstVal (ListValue nil)). + +Fixpoint simplifySt + (erule : (list Context) + -> absExp -> absExp) + (rule : list Context -> absState -> + absState) + (context : list Context) + (s : absState) : absState := + rule context (match s with - | AbsStar l r => match simplifySt erule rule n ((buildStateContext r)++context) l with - | ll => AbsStar ll (simplifySt erule rule n ((buildStateContext ll)++context) r) + | AbsStar l r => match simplifySt erule rule ((buildStateContext r)++context) l with + | ll => AbsStar ll (simplifySt erule rule ((buildStateContext ll)++context) r) end - | AbsOrStar l r => match simplifySt erule rule n ((buildNegStateContext r)++context) l with - | ll => AbsOrStar ll (simplifySt erule rule n ((buildNegStateContext ll)++context) r) + | AbsOrStar l r => match simplifySt erule rule ((buildNegStateContext r)++context) l with + | ll => AbsOrStar ll (simplifySt erule rule ((buildNegStateContext ll)++context) r) end - | AbsExistsT s => AbsExistsT (simplifySt erule rule (S n) (enterQuant context) s) - | AbsExists l s => AbsExists (simplifyExp erule context n l) - (simplifySt erule rule (S n) ((Domain (S n) l)::(enterQuant context)) s) - | AbsAll l s => AbsAll (simplifyExp erule context n l) - (simplifySt erule rule (S n) ((Domain (S n) l)::(enterAll l context)) s) - | AbsEach l s => AbsEach (simplifyExp erule context n l) - (simplifySt erule rule (S n) ((Domain (S n) l)::(enterQuant context)) s) - | AbsLeaf f l => AbsLeaf f (map (simplifyExp erule context n) l) - | AbsAccumulate i e1 e2 e3 => AbsAccumulate i (simplifyExp erule context n e1) - (simplifyExp erule ((Domain (S n) e1)::(enterQuant context)) (n+1) e2) - (simplifyExp erule context n e3) + | AbsExistsT s => AbsExistsT (simplifySt erule rule (enterQuant context) s) + | AbsExists l s => AbsExists (simplifyExp erule context l) + (simplifySt erule rule ((Domain 0 (addExpVar 0 l))::(enterQuant context)) s) + | AbsAll l s => AbsAll (simplifyExp erule context l) + (simplifySt erule rule ((Domain 0 (addExpVar 0 l))::(enterAll l context)) s) + | AbsEach l s => AbsEach (simplifyExp erule context l) + (simplifySt erule rule ((Domain 0 (addExpVar 0 l))::(enterQuant context)) s) + | AbsLeaf f l => AbsLeaf f (map (simplifyExp erule context) l) + | AbsAccumulate i e1 e2 e3 => AbsAccumulate i (simplifyExp erule context e1) + (simplifyExp erule ((Domain 0 e1)::(enterQuant context)) e2) + (simplifyExp erule context e3) + | AbsUpdateVar s v e => AbsUpdateVar (simplifySt erule rule context s) v (simplifyExp erule context e) + | AbsUpdateWithLoc s v e => AbsUpdateWithLoc (simplifySt erule rule context s) v (simplifyExp erule context e) + | AbsUpdateLoc s l e => AbsUpdateLoc (simplifySt erule rule context s) (simplifyExp erule context l) (simplifyExp erule context e) + | AbsUpdState s s1 s2 => AbsUpdState (simplifySt erule rule context s) (simplifySt erule rule context s1) (simplifySt erule rule context s2) + | AbsMagicWand s1 s2 => AbsMagicWand (simplifySt erule rule context s1) (simplifySt erule rule context s2) | x => x end). -Fixpoint srule {ev} {eq} {f} {t} {ac} (n : nat) (context : list (@Context ev eq f t ac)) - (s : @absState ev eq f t ac) : @absState ev eq f t ac := - match s return @absState ev eq f t ac with - | AbsStar l r => match l with +Fixpoint srule (context : list Context) + (s : absState) : absState := + match s return absState with + (*| AbsStar l r => match l with | ([#x]) => if beq_nat x 0 then ([#0]) else r | AbsEmpty => r | AbsExistsT ll => match r with @@ -756,30 +779,97 @@ Fixpoint srule {ev} {eq} {f} {t} {ac} (n : nat) (context : list (@Context ev eq | rr => AbsStar ll rr end end - | AbsExistsT s => match pickAssignment n s return @absState ev eq f t ac with - | Some (s',e) => removeStateVar n (substState s' n e) - | None => if hasVnState s n then AbsExistsT s else removeStateVar n s + | AbsMagicWand l r => match l with + | ([#x]) => if beq_nat x 0 then ([#0]) else r + | AbsEmpty => r + | AbsExistsT ll => match r with + | AbsEmpty => AbsExistsT ll + | rr => AbsExistsT (AbsMagicWand ll (addStateVar n rr)) + end + | AbsExists l ll => match r with + | AbsEmpty => AbsExists l ll + | rr => AbsExists l (AbsMagicWand ll (addStateVar n rr)) + end + | ll => match r with + | ([#x]) => if beq_nat x 0 then ([#0]) else l + | AbsEmpty => ll + | AbsExistsT rr => AbsExistsT (AbsMagicWand (addStateVar n ll) rr) + | AbsExists l rr => AbsExists l (AbsMagicWand (addStateVar n ll) rr) + | rr => AbsMagicWand ll rr + end + end*) + | AbsExistsT s => match pickAssignment 0 s return absState with + | Some (s',e) => removeStateVar 0 (substState s' 0 e) + | None => if hasVnState s 0 then AbsExistsT s else removeStateVar 0 s end | AbsExists(TreeRecords(v)) s => if pickC v context then [#0] - else match ((TreeRecords(v)),s) return @absState ev eq f t ac with - | ((TreeRecords(e)),s') => unfoldExists e s' n + else match ((TreeRecords(v)),s) return absState with + | ((TreeRecords(e)),s') => unfoldExists e s' 0 | (e,s') => AbsExists e s' end - | AbsExists l s =>match pickAssignment n s return @absState ev eq f t ac with - | Some (s',e) => removeStateVar n (substState s' n e) - | None => if hasVnState s n then AbsExists l s else removeStateVar n s + | AbsExists(AbsConstVal (ListValue nil)) s => AbsNone + | AbsExists(AbsConstVal (NatValue _)) s => AbsNone + | AbsExists l s =>match pickAssignment 0 s return absState with + | Some (s',e) => removeStateVar 0 (substState s' 0 e) + | None => if hasVnState s 0 then AbsExists l s else removeStateVar 0 s end | AbsAll(AbsConstVal (ListValue nil)) s => AbsEmpty + | AbsAll(AbsConstVal (NatValue _)) s => AbsEmpty | AbsAll(TreeRecords(v)) s => if pickC v context then AbsEmpty - else match ((TreeRecords(v)),s) return @absState ev eq f t ac with + else match ((TreeRecords(v)),s) return absState with | (e,(AbsStar l r)) => (AbsStar (AbsAll e l) (AbsAll e r)) - | ((TreeRecords(e)),s') => unfoldAll e s' n + | ((TreeRecords(e)),s') => unfoldAll e s' 0 | (e,s') => AbsAll e s' end - | AbsAll v s => match v,s return @absState ev eq f t ac with + | AbsAll v s => match v,s return absState with | v',AbsStar l r => AbsStar (AbsAll v' l) (AbsAll v' r) | v',s' => AbsAll v' s' end + | AbsStar (AbsUpdateVar l v e) r => if hasVarState r v then + match r return absState with + | AbsUpdateVar rr vv ee => + if hasVarState l vv then + s + else + AbsUpdateVar (AbsStar (AbsUpdateVar l v e) rr) vv ee + | x => AbsStar (AbsUpdateVar l v e) r + end + else + AbsUpdateVar (AbsStar l r) v e + | (AbsStar l (AbsUpdateVar r v e)) => if hasVarState l v then + s + else + AbsUpdateVar (AbsStar l r) v e + (*| AbsMagicWand (AbsUpdateVar l v e) r => if hasVarState r v then + match r return @absState ev eq f t ac with + | AbsUpdateVar rr vv ee => + if hasVarState l vv then + s + else + AbsUpdateVar (AbsMagicWand (AbsUpdateVar l v e) rr) vv ee + | x => AbsMagicWand (AbsUpdateVar l v e) r + end + else + AbsUpdateVar (AbsMagicWand l r) v e + | (AbsMagicWand l (AbsUpdateVar r v e)) => if hasVarState l v then + s + else + AbsUpdateVar (AbsMagicWand l r) v e*) + (*| AbsMagicWand (AbsUpdateWithLoc l v e) r => if hasVarState r v then + match r return @absState ev eq f t ac with + | AbsUpdateWithLoc rr vv ee => + if hasVarState l vv then + s + else + AbsUpdateWithLoc (AbsMagicWand (AbsUpdateWithLoc l v e) rr) vv ee + | x => AbsMagicWand (AbsUpdateWithLoc l v e) r + end + else + AbsUpdateWithLoc (AbsMagicWand l r) v e + | (AbsMagicWand l (AbsUpdateWithLoc r v e)) => if hasVarState l v then + s + else + AbsUpdateWithLoc (AbsMagicWand l r) v e*) | [(a //\\ b)] => AbsStar ([a]) ([b]) | [(~~a \\// ~~b)] => if pickPred a context then [~~b] @@ -805,15 +895,86 @@ Fixpoint srule {ev} {eq} {f} {t} {ac} (n : nat) (context : list (@Context ev eq [a] else [a] *\/* [b] - | (x *\/* [(#0)]) => x - | ([(#0)] *\/* x) => x - | [(#n)] => if beq_nat n 0 then [#n] else AbsEmpty + | (x *\/* AbsNone) => x + | (x ** AbsEmpty) => x + | (AbsEmpty ** x) => x + | (AbsNone *\/* x) => x + | [(#n)] => if beq_nat n 0 then AbsNone else AbsEmpty | AbsLeaf (AbsTreeId) (#0::v::_) => [equalsNil v] + | [x ==== (#0)] => if hasNonZero context x then AbsNone else [x ==== (#0)] + | [(#0) ==== x] => if hasNonZero context x then AbsNone else [(#0) ==== x] + | x => x + end. + +Fixpoint existsrule (context : list Context) + (s : absState) : absState := + match s return absState with + | AbsStar l r => match l with + | ([#x]) => if beq_nat x 0 then ([#0]) else r + | AbsEmpty => r + | AbsExistsT ll => match r with + | AbsEmpty => AbsExistsT ll + | rr => AbsExistsT (AbsStar ll (addStateVar 0 rr)) + end + | AbsExists l ll => match r with + | AbsEmpty => AbsExists l ll + | rr => AbsExists l (AbsStar ll (addStateVar 0 rr)) + end + | ll => match r with + | AbsExistsT rr => AbsExistsT (AbsStar (addStateVar 0 ll) rr) + | AbsExists l rr => AbsExists l (AbsStar (addStateVar 0 ll) rr) + | rr => AbsStar ll rr + end + end + | AbsMagicWand l r => match l with + | AbsEmpty => r + | AbsExistsT ll => match r with + | AbsEmpty => AbsExistsT ll + | rr => AbsExistsT (AbsMagicWand ll (addStateVar 0 rr)) + end + | AbsExists l ll => match r with + | AbsEmpty => AbsExists l ll + | rr => AbsExists l (AbsMagicWand ll (addStateVar 0 rr)) + end + | ll => match r with + | ([#x]) => if beq_nat x 0 then ([#0]) else l + (*| AbsExistsT rr => AbsExistsT (AbsMagicWand (addStateVar 0 ll) rr) + | AbsExists l rr => AbsExists l (AbsMagicWand (addStateVar 0 ll) rr)*) + | rr => AbsMagicWand ll rr + end + end + | AbsUpdateVar (AbsExistsT s) v e => (AbsExistsT (AbsUpdateVar s v (addExpVar 0 e))) + | AbsUpdateLoc (AbsExistsT s) v e => (AbsExistsT (AbsUpdateLoc s v (addExpVar 0 e))) + | AbsUpdateWithLoc (AbsExistsT s) v e => (AbsExistsT (AbsUpdateWithLoc s v (addExpVar 0 e))) + | x => x + end. + +Fixpoint srule2 (context : list Context ) + (s : absState) : absState := + match s return absState with + | AbsStar (AbsUpdateVar l v e) r => if hasVarState r v then + match r return absState with + | AbsUpdateVar rr vv ee => + if hasVarState l vv then + s + else + AbsUpdateVar (AbsStar (AbsUpdateVar l v e) rr) vv ee + | x => AbsStar (AbsUpdateVar l v e) r + end + else + AbsUpdateVar (AbsStar l r) v e + | (AbsStar l (AbsUpdateVar r v e)) => if hasVarState l v then + s + else + AbsUpdateVar (AbsStar l r) v e | x => x end. -Fixpoint simplifyState {ev} {eq} {f} {t} {ac} (n : nat) (context : list (@Context ev eq f t ac)) (s : @absState ev eq f t ac) : @absState ev eq f t ac := - simplifySt (fun c n e => (basicExpRule1 c n e)) srule n context s. +Fixpoint simplifyState (context : list Context) (s : absState) : absState := + simplifySt (fun c e => (basicExpRule1 c e)) srule context s. + +Fixpoint propagateExists (context : list Context) (s : absState) : absState := + simplifySt (fun c e => (basicExpRule1 c e)) existsrule context s. (*Fixpoint simplifyState {ev} {eq} {f} {t} {ac} (n : nat) (context : list (@Context ev eq f t ac)) (s : @absState ev eq f t ac) : @absState ev eq f t ac := match s return @absState ev eq f t ac with @@ -899,81 +1060,620 @@ Fixpoint simplifyState {ev} {eq} {f} {t} {ac} (n : nat) (context : list (@Contex Ltac simplifyState := (compute; reflexivity). -Theorem simplifyEquiv1 {ev} {eq} {f} {t} {ac} : forall (s : @absState ev eq f t ac) s' state, - s' = @simplifyState ev eq f t ac 0 nil s -> +Theorem simplifyEquiv1 : forall (s : absState) s' state, + s' = simplifyState nil s -> realizeState s nil state -> realizeState s' nil state. -Proof. admit. Qed. +Proof. admit. Admitted. + +Theorem propagateExistsEquiv1 : forall (s : absState) s' state b, + s' = propagateExists nil s -> + realizeState s b state -> + realizeState s' b state. +Proof. admit. Admitted. -Definition basicSimplifyEquiv1 := @simplifyEquiv1 unit eq_unit unitEval basicState basicAccumulate. +Ltac simplifyTheHyp H := eapply simplifyEquiv1 in H; [idtac | compute; reflexivity]. -Theorem simplifyEquivb1 {ev} {eq} {f} {t} {ac} : forall (s : @absState ev eq f t ac) s' b state, - s' = @simplifyState ev eq f t ac (length b) nil s -> +Definition basicSimplifyEquiv1 := simplifyEquiv1. + +Theorem simplifyEquivb1 : forall (s : absState) s' b state, + s' = simplifyState nil s -> realizeState s b state -> realizeState s' b state. -Proof. admit. Qed. +Proof. admit. Admitted. Ltac simplifyHyp X:= eapply simplifyEquivb1 in X;[compute in X|simplifyState]. -Theorem simplifyEquiv2 {ev} {eq} {f} {t} {ac} : forall (s : @absState ev eq f t ac) s' state b, - s' = @simplifyState ev eq f t ac (length b) nil s -> +Theorem simplifyEquiv2 : forall (s : absState) s' state b, + s' = simplifyState nil s -> realizeState s' b state -> realizeState s b state. -Proof. admit. Qed. - -Theorem simplifyAbsEval {ev} {eq} {f} {t} {ac} : forall (e : @absExp ev eq f) e' b env, - e' = @simplifyExpression ev eq f t ac nil (length b) e -> - @absEval ev eq f env b e'= @absEval ev eq f env b e. -Proof. admit. Qed. +Proof. admit. Admitted. -Theorem simplifyPre {ev} {eq} {f} {t} {ac} : forall (s : @absState ev eq f t ac) s' cmd post r, - s' = @simplifyState ev eq f t ac 0 nil s -> - {{ s' }} cmd {{ post, r }} -> - {{ s }} cmd {{ post, r }}. -Proof. - unfold hoare_triple. unfold absExecute. intros. - eapply H0. eapply simplifyEquiv1. apply H. apply H1. -Qed. - -Theorem tsimplifyPre {ev} {eq} {f} {t} {ac} : forall (s : @absState ev eq f t ac) s' cmd post r, - {{ s' }} cmd {{ post, r }} -> - s' = @simplifyState ev eq f t ac 0 nil s -> - {{ s }} cmd {{ post, r }}. -Proof. - unfold hoare_triple. unfold absExecute. intros. - eapply H. eapply simplifyEquiv1. apply H0. apply H1. -Qed. +Theorem propagateExistsEquiv2 : forall (s : absState) s' state b, + s' = propagateExists nil s -> + realizeState s' b state -> realizeState s b state. +Proof. admit. Admitted. + +Ltac simplify := eapply simplifyEquiv2; compute; [reflexivity | idtac]. +Ltac propagateExists := eapply propagateExistsEquiv2; compute; [reflexivity | idtac]. +Ltac propagateExistsHyp H := eapply propagateExistsEquiv1 in H; [compute in H | simplifyState]. + +Theorem simplifyAbsEval : forall (e : absExp) e' b env, + e' = simplifyExpression nil e -> + absEval env b e'= absEval env b e. +Proof. admit. Admitted. + +Theorem simplifyPre : forall (s : absState) s' cmd post r post', + s' = simplifyState nil s -> + {{ s' }} cmd {{ post return r with post'}} -> + {{ s }} cmd {{ post return r with post'}}. +Proof. admit. + (*unfold hoare_triple. unfold absExecute. intros. + eapply H0. eapply simplifyEquiv1. apply H. apply H1.*) +Admitted. + +Theorem tsimplifyPre : forall (s : absState) s' cmd post r post', + {{ s' }} cmd {{ post return r with post' }} -> + s' = simplifyState nil s -> + {{ s }} cmd {{ post return r with post' }}. +Proof. admit. + (*unfold hoare_triple. unfold absExecute. intros. + eapply H. eapply simplifyEquiv1. apply H0. apply H1.*) +Admitted. Opaque basicEval. Ltac simp := eapply simplifyPre;[(compute;reflexivity)|idtac]. Ltac simplifyPre := repeat (progress simp). -Ltac simpBasic := eapply (@simplifyPre unit eq_unit - (@basicEval unit) - (@basicState unit) (@basicAccumulate unit eq_unit) tt) +Ltac simpBasic := eapply (simplifyPre tt) ;[simplifyState|(instantiate;simpl)] || idtac. Ltac simplifyPreBasic := repeat (progress simpBasic). -Theorem mergeSimplifyLeft {ev} {eq} {f} {t} {ac} : forall (P1 : @absState ev eq f t ac) P1' P2 P, - P1' = @simplifyState ev eq f t ac 0 nil P1 -> +Theorem realizeStateSimplify: forall (P : absState) P' bindings s, + P' = simplifyState nil P -> + realizeState P' bindings s -> + realizeState P bindings s. +Proof. + admit. +Admitted. + +Theorem mergeSimplifyLeft : forall (P1 : absState) P1' P2 P, + P1' = simplifyState nil P1 -> mergeStates P1' P2 P -> mergeStates P1 P2 P. -Proof. unfold mergeStates. intros. inversion H0. subst. clear H0. split. - intros. eapply H1. eapply simplifyEquiv1. reflexivity. apply H. intros. apply H2. apply H. -Qed. +Proof. (*unfold mergeStates. intros. inversion H0. subst. clear H0. split. + intros. eapply H1. eapply simplifyEquiv1. reflexivity. apply H. intros. apply H2. apply H.*) admit. +Admitted. -Theorem mergeSimplifyRight {ev} {eq} {f} {t} {ac} : forall (P1 : @absState ev eq f t ac) P2 P2' P, - P2' = @simplifyState ev eq f t ac 0 nil P2 -> +Theorem mergeSimplifyRight: forall (P1 : absState) P2 P2' P, + P2' = simplifyState nil P2 -> mergeStates P1 P2' P -> mergeStates P1 P2 P. -Proof. unfold mergeStates. intros. inversion H0. subst. clear H0. split. +Proof. (*unfold mergeStates. intros. inversion H0. subst. clear H0. split. intros. apply H1. apply H. intros. eapply H2. eapply simplifyEquiv1. - reflexivity. eapply H. -Qed. + reflexivity. eapply H.*) admit. +Admitted. -Ltac simpleft := eapply mergeSimplifyLeft;[(simpl;reflexivity)|idtac]. +Ltac simpleft := eapply mergeSimplifyLeft;[(compute;reflexivity)|idtac]. Ltac mergeSimplifyLeft := repeat (progress simpleft). -Ltac simpright := eapply mergeSimplifyRight;[(simpl;reflexivity)|idtac]. +Ltac simpright := eapply mergeSimplifyRight;[(compute;reflexivity)|idtac]. Ltac mergeSimplifyRight := repeat (progress simpright). + +Theorem mergePropagateLeft : forall (P1 : absState) P1' P2 P, + P1' = propagateExists nil P1 -> + mergeStates P1' P2 P -> + mergeStates P1 P2 P. +Proof. (*unfold mergeStates. intros. inversion H0. subst. clear H0. split. + intros. eapply H1. eapply simplifyEquiv1. reflexivity. apply H. intros. apply H2. apply H.*) admit. +Admitted. + +Theorem mergePropagateRight : forall (P1 : absState) P2 P2' P, + P2' = propagateExists nil P2 -> + mergeStates P1 P2' P -> + mergeStates P1 P2 P. +Proof. (*unfold mergeStates. intros. inversion H0. subst. clear H0. split. + intros. apply H1. apply H. intros. eapply H2. eapply simplifyEquiv1. + reflexivity. eapply H.*) admit. +Admitted. + +Ltac propleft := eapply mergePropagateLeft;[(compute;reflexivity)|idtac]. +Ltac mergePropagateExistsLeft := repeat (progress propleft). + +Ltac propright := eapply mergePropagateRight;[(compute;reflexivity)|idtac]. +Ltac mergePropagateExistsRight := repeat (progress propright). + + +Function stripUpdateVar (s : absState) := + match s with + | AbsUpdateVar ss i v => + match substVarState (addStateVar 0 (stripUpdateVar ss)) i v(0) with + | Some x => [!!(i) ==== v] ** (AbsExistsT x) + | None => AbsUpdateVar ss i v + end + | (a ** b) => (stripUpdateVar a) ** (stripUpdateVar b) + | AbsExistsT x => AbsExistsT (stripUpdateVar x) + | AbsUpdateLoc s i v => AbsUpdateLoc (stripUpdateVar s) i v + | AbsUpdateWithLoc s i v => AbsUpdateWithLoc (stripUpdateVar s) i v + | AbsMagicWand l r => AbsMagicWand (stripUpdateVar l) r + | x => x + end. + +Function findCell (e : absExp) (s : absState) := + match s with + | AbsStar a b => match findCell e a with + | Some x => Some x + | None => findCell e b + end + | AbsUpdateWithLoc s i v => if hasVarExp e i then None else findCell e s + | AbsUpdateVar s i v => if hasVarExp e i then None else findCell e s + | x |-> y => if beq_absExp x e then Some y else None + | _ => None + end. + +Function stripUpdateWithLoc (s : absState) := + match s with + | AbsUpdateWithLoc ss i v => match findCell v ss,substVarState (addStateVar 0 (stripUpdateWithLoc ss)) i v(0) with + | Some v,Some x => [!!(i) ==== v] ** (AbsExistsT x) + | _,_ => AbsUpdateWithLoc (stripUpdateWithLoc ss) i v + end + | (a ** b) => (stripUpdateWithLoc a) ** (stripUpdateWithLoc b) + | AbsExistsT x => AbsExistsT (stripUpdateWithLoc x) + | AbsUpdateLoc s i v => AbsUpdateLoc (stripUpdateWithLoc s) i v + | AbsUpdateVar s i v => AbsUpdateVar (stripUpdateWithLoc s) i v + | AbsMagicWand l r => AbsMagicWand (stripUpdateWithLoc l) r + | x => x + end. + +Theorem stripUpdateVarLeft : forall left left' right m, + left' = stripUpdateVar left -> + mergeStates left' right m -> + mergeStates left right m. +Proof. + admit. +Admitted. + +Theorem stripUpdateVarLeftp + : forall left right m, + mergeStates (stripUpdateVar left) right m -> mergeStates left right m. +Proof. + admit. +Admitted. + + +Theorem stripUpdateWithLocLeft : forall left left' right m, + left' = stripUpdateWithLoc left -> + mergeStates left' right m -> + mergeStates left right m. +Proof. + admit. +Admitted. + +Theorem stripUpdateWithLocLeftp + : forall P1 P2 P, + mergeStates (stripUpdateWithLoc P1) P2 P -> mergeStates P1 P2 P. +Proof. + admit. +Admitted. + +Theorem stripUpdateVarRight : forall left right' right m, + right' = stripUpdateVar right -> + mergeStates left right' m -> + mergeStates left right m. +Proof. + admit. +Admitted. + +Theorem stripUpdateVarRightp + : forall left right m, + mergeStates left (stripUpdateVar right) m -> mergeStates left right m. +Proof. + admit. +Admitted. + +Theorem stripUpdateWithLocRightp + : forall P1 P2 P, + mergeStates P1 (stripUpdateWithLoc P2) P -> mergeStates P1 P2 P. +Proof. + admit. +Admitted. + +Theorem stripUpdateWithLocRight : forall left right' right m, + right' = stripUpdateWithLoc right -> + mergeStates left right' m -> + mergeStates left right m. +Proof. + admit. +Admitted. + +Theorem stripUpdateVarHyp : forall state state' b s, + realizeState state b s -> + state' = stripUpdateVar state -> + realizeState state' b s. +Proof. + admit. +Admitted. + +Theorem stripUpdateVarHypp : forall state b s, + realizeState state b s -> + realizeState (stripUpdateVar state) b s. +Proof. + admit. +Admitted. + +Theorem stripUpdateWithLocHyp : forall state state' b s, + realizeState state b s -> + state' = stripUpdateWithLoc state -> + realizeState state' b s. +Proof. + admit. +Admitted. + +Theorem stripUpdateWithLocHypp : forall state b s, + realizeState state b s -> + realizeState (stripUpdateWithLoc state) b s. +Proof. + admit. +Admitted. + +Theorem stripUpdateVarp : forall state b s, + realizeState (stripUpdateVar state) b s -> + realizeState state b s. +Proof. + admit. +Admitted. + +Theorem stripUpdateWithLocp : forall state b s, + realizeState (stripUpdateWithLoc state) b s -> + realizeState state b s. +Proof. + admit. +Admitted. + +Theorem mergeReductionUpdateVarLeft : forall (va : id) (l : absState) + (r : absState) (m : absState) + (vall : absExp), + mergeStates l r m -> + hasVarState l va = false -> + hasVarExp vall va = false -> + mergeStates (AbsUpdateVar l va vall) r m. +Proof. + admit. +Admitted. + +Theorem mergeReductionUpdateVarLeft2 : forall (va : id) (l : absState) + (r : absState) (m : absState) + (vall : absExp), + mergeStates l r m -> + (forall b s, realizeState (AbsUpdateVar l va vall) b s -> realizeState l b s) -> + mergeStates (AbsUpdateVar l va vall) r m. +Proof. + admit. +Admitted. + +Theorem mergeReductionUpdateVarLeft3 : forall (va : id) (l : absState) + (r : absState) (m : absState) + (vall : absExp), + mergeStates l r m -> + (forall s b, realizeState l b s -> (NatValue (fst s va))=absEval (fst s) b vall) -> + mergeStates (AbsUpdateVar l va vall) r m. +Proof. + admit. +Admitted. + +Theorem mergeReductionUpdateWithLocLeft : forall (va : id) (l : absState) + (r : absState) (m : absState) + (vall : absExp), + mergeStates l r m -> + hasVarState l va = false -> + hasVarExp vall va = false -> + mergeStates (AbsUpdateWithLoc l va vall) r m. +Proof. + admit. +Admitted. + +Theorem mergeReductionUpdateWithLocRight : forall (va : id) (l : absState) + (r : absState) (m : absState) + (vall : absExp), + mergeStates l r m -> + hasVarState r va = false -> + hasVarExp vall va = false -> + mergeStates l (AbsUpdateWithLoc r va vall) m. +Proof. + admit. +Admitted. + +Theorem mergeImplies : forall (s1 : absState) s2 m1 m2, + mergeStates s1 s2 m1 -> + (forall s b, realizeState m1 b s -> realizeState m2 b s) -> + mergeStates s1 s2 m2. +Proof. + admit. +Admitted. + +Theorem mergeSame : forall (s : absState), + mergeStates s s s. +Proof. + admit. +Admitted. + +Theorem removeCondLeftLeft : forall (c : absExp) (s1 : absState) (s2 : absState) (m : absState), + mergeStates s1 s2 m -> + mergeStates (AbsStar ([c]) s1) s2 m. +Proof. + admit. +Admitted. + +Theorem removeCondRightLeft : forall (c : absExp) (s1 : absState) (s2 : absState) (m : absState), + mergeStates s1 s2 m -> + mergeStates s1 (AbsStar ([c]) s2) m. +Proof. + admit. +Admitted. + +Fixpoint updateCell (p : absState) (loc : absExp) (v : absExp) := + match p with + | AbsStar l r => match updateCell l loc v with + | Some ll => Some (AbsStar ll r) + | None => match updateCell r loc v with + | Some rr => Some (AbsStar l rr) + | None => None + end + end + | AbsExistsT e => match updateCell e (addExpVar 0 loc) (addExpVar 0 v) with + | Some l => Some (AbsExistsT l) + | None => None + end + | AbsExists ee e => match updateCell e (addExpVar 0 loc) (addExpVar 0 v) with + | Some l => Some (AbsExists ee l) + | None => None + end + | (l |-> _) => if beq_absExp l loc then Some (l |-> v) else None + | _ => None + end. + +Fixpoint removeUpdateLoc (s : absState) := + match s with + | AbsExistsT e => match removeUpdateLoc e with + | Some x => Some (AbsExistsT x) + | None => None + end + | AbsExists e s => match removeUpdateLoc s with + | Some x => Some (AbsExists e x) + | None => None + end + | AbsStar l r => match removeUpdateLoc l with + | Some x => Some (AbsStar x r) + | None => match removeUpdateLoc r with + | Some x => Some (AbsStar l x) + | None => None + end + end + | AbsUpdateVar s v e => match removeUpdateLoc s with + | Some x => Some (AbsUpdateVar x v e) + | None => None + end + | AbsUpdateWithLoc s v e => match removeUpdateLoc s with + | Some x => Some (AbsUpdateWithLoc x v e) + | None => None + end + | AbsMagicWand l r => match removeUpdateLoc l with + | Some x => Some (AbsMagicWand x r) + | None => match removeUpdateLoc r with + | Some x => Some (AbsMagicWand l x) + | None => None + end + end + | AbsUpdateLoc s v e => match updateCell s v e with + | Some x => Some x + | None => match removeUpdateLoc s with + | Some x => Some (AbsUpdateLoc x v e) + | None => None + end + end + | x => None + end. + +Theorem removeUpdateLocHyp : forall state b s x, + Some x = removeUpdateLoc state -> + realizeState state b s -> realizeState x b s. +Proof. admit. Admitted. + +Theorem removeUpdateLocThm : forall state b s x, + Some x = removeUpdateLoc state -> + realizeState x b s -> realizeState state b s. +Proof. admit. Admitted. + +Theorem removeUpdateLocLeft : forall left left' right merge, + Some left' = removeUpdateLoc left -> + mergeStates left' right merge -> mergeStates left right merge. +Proof. admit. Admitted. + +Theorem removeUpdateLocRight : forall left right' right merge, + Some right' = removeUpdateLoc right -> + mergeStates left right' merge -> mergeStates left right merge. +Proof. admit. Admitted. + +Fixpoint findAssignments (v : id) (s : absState) : list absExp := + match s with + | AbsStar l r => (findAssignments v l)++(findAssignments v r) + | [(!!vv)====(!!vvv)] => if beq_id vv v then (!!vvv)::nil else + if beq_id vvv v then (!!vv)::nil else nil + | [(!!vv)====e] => if beq_id vv v then e::nil else nil + | [e====(!!vv)] => if beq_id vv v then e::nil else nil + | _ => nil + end. + +Fixpoint replaceExp (p : absExp) (r : absExp) (t : absExp) := + if beq_absExp p t then r + else match t with + | AbsFun i l => AbsFun i (map (replaceExp p r) l) + | x => x + end. + +Fixpoint replaceState (p : absExp) (r : absExp) (s : absState) : option absState := + match s with + | AbsStar s1 s2 => match replaceState p r s1,replaceState p r s2 with + | Some a,Some b => Some (AbsStar a b) + | _,_ => None + end + | AbsOrStar s1 s2 => match replaceState p r s1,replaceState p r s2 with + | Some a,Some b => Some (AbsOrStar a b) + | _,_ => None + end + | AbsExistsT s => match replaceState (addExpVar 0 p) (addExpVar 0 r) s with + | Some x => Some (AbsExistsT x) + | _ => None + end + | AbsExists e s => match replaceState (addExpVar 0 p) (addExpVar 0 r) s with + | Some x => Some (AbsExists (replaceExp p r e) x) + | None => None + end + | AbsAll e s => match replaceState (addExpVar 0 p) (addExpVar 0 r) s with + | Some x => Some (AbsAll (replaceExp p r e) x) + | None => None + end + | AbsEach e s => match replaceState (addExpVar 0 p) (addExpVar 0 r) s with + | Some x => Some (AbsEach (replaceExp p r e) x) + | None => None + end + | AbsEmpty => Some AbsEmpty + | AbsAny => Some AbsAny + | AbsNone => Some AbsNone + | AbsLeaf i l => Some (AbsLeaf i (map (fun x => replaceExp p r x) l)) + | AbsAccumulate id e1 e2 e3 => Some (AbsAccumulate id (replaceExp p r e1) (replaceExp p r e2) (replaceExp p r e3)) + | AbsMagicWand s1 s2 => match replaceState p r s1,replaceState p r s2 with + | Some a,Some b => Some (AbsMagicWand a b) + | _,_ => None + end + | AbsUpdateVar s v vall => if hasVarExp p v then None + else if hasVarExp r v then None + else match replaceState p r s with + | Some x => Some (AbsUpdateVar x v (replaceExp p r vall)) + | _ => None + end + | AbsUpdateWithLoc s v vall => if hasVarExp p v then None + else if hasVarExp p v then None + else match replaceState p r s with + | Some x => Some (AbsUpdateWithLoc x v (replaceExp p r vall)) + | _ => None + end + | AbsUpdateLoc s v vall => match (replaceState p r s),(replaceExp p r v),(replaceExp p r vall) with + | Some a,b,c => Some (AbsUpdateLoc a b c) + | _,_,_ => None + end + | AbsUpdState s1 s2 s3 => match (replaceState p r s1),(replaceState p r s2),(replaceState p r s3) with + | Some a,Some b,Some c => Some (AbsUpdState a b c) + | _,_,_ => None + end + | AbsClosure s l => Some (AbsClosure s (map (replaceExp p r) l)) + end. + +Fixpoint listReplace (v : id) (r : list absExp) (e : absExp) : option absExp := + match r with + | (a::b) => if beq_absExp e a then Some (!!v) else listReplace v b e + | nil => None + end. + +Fixpoint findAssignmentsExp (v: id) (r : list absExp) (e: absExp): absExp := + (*match r with + | (_::_::nil) => v(123) + | _ =>*) + match e with + | AbsFun id l => match listReplace v r e with + | Some x => x + | None => AbsFun id (map (findAssignmentsExp v r) l) + end + | x => match listReplace v r x with Some y => y | None => e end + end (*end*). + +Fixpoint findAssignmentsState (v : id) (r : list absExp) (s : absState) : option absState := + match s with + | AbsStar s1 s2 => match findAssignmentsState v r s1,findAssignmentsState v r s2 with + | Some a,Some b => Some (AbsStar a b) + | _,_ => None + end + | AbsOrStar s1 s2 => match findAssignmentsState v r s1,findAssignmentsState v r s2 with + | Some a,Some b => Some (AbsOrStar a b) + | _,_ => None + end + | AbsExistsT s => match findAssignmentsState v (map (addExpVar 0) r) s with + | Some x => Some (AbsExistsT x) + | _ => None + end + | AbsExists e s => match findAssignmentsState v (map (addExpVar 0) r) s with + | Some x => Some (AbsExists (findAssignmentsExp v r e) x) + | None => None + end + | AbsAll e s => match findAssignmentsState v (map (addExpVar 0) r) s with + | Some x => Some (AbsAll (findAssignmentsExp v r e) x) + | None => None + end + | AbsEach e s => match findAssignmentsState v (map (addExpVar 0) r) s with + | Some x => Some (AbsEach (findAssignmentsExp v r e) x) + | None => None + end + | AbsEmpty => Some AbsEmpty + | AbsAny => Some AbsAny + | AbsNone => Some AbsNone + | ([(!!vv)====e]) => if beq_id vv v then Some ([(!!vv)====e]) + else Some ([findAssignmentsExp v r ((!!v)====e)]) + | ([e====(!!vv)]) => if beq_id vv v then Some ([(!!vv)====e]) + else Some ([findAssignmentsExp v r ((!!v)====e)]) + | AbsLeaf i l => Some (AbsLeaf i (map (fun x => findAssignmentsExp v r x) l)) + | AbsAccumulate id e1 e2 e3 => Some (AbsAccumulate id (findAssignmentsExp v r e1) (findAssignmentsExp v r e2) (findAssignmentsExp v r e3)) + | AbsMagicWand s1 s2 => match findAssignmentsState v r s1,findAssignmentsState v r s2 with + | Some a,Some b => Some (AbsMagicWand a b) + | _,_ => None + end + | AbsUpdateVar s vv vall => if beq_id vv v then None + else if hasVarExpList r vv then None + else match findAssignmentsState v r s with + | Some x => Some (AbsUpdateVar x v (findAssignmentsExp v r vall)) + | _ => None + end + | AbsUpdateWithLoc s vv vall => if beq_id vv v then None + else if hasVarExpList r vv then None + else match findAssignmentsState v r s with + | Some x => Some (AbsUpdateWithLoc x v (findAssignmentsExp v r vall)) + | _ => None + end + | AbsUpdateLoc s vv vall => match (findAssignmentsState v r s),(findAssignmentsExp v r vv),(findAssignmentsExp v r vall) with + | Some a,b,c => Some (AbsUpdateLoc a b c) + | _,_,_ => None + end + | AbsUpdState s1 s2 s3 => match (findAssignmentsState v r s1),(findAssignmentsState v r s2),(findAssignmentsState v r s3) with + | Some a,Some b,Some c => Some (AbsUpdState a b c) + | _,_,_ => None + end + | AbsClosure s l => Some (AbsClosure s (map (findAssignmentsExp v r) l)) + end. + +Fixpoint normalize (v : id) (s : absState) := + match s with + | AbsExistsT s => AbsExistsT (normalize v s) + | AbsUpdateVar s i vv => AbsUpdateVar (normalize v s) i vv + | AbsUpdateLoc s i vv => AbsUpdateLoc (normalize v s) i vv + | AbsUpdateWithLoc s i vv => AbsUpdateWithLoc (normalize v s) i vv + | x => match findAssignmentsState v (findAssignments v x) x with + | Some q => q + | None => x + end + end. + +Theorem normalizeLeft : forall v left right merge, + mergeStates (normalize v left) right merge -> mergeStates left right merge. +Proof. admit. Admitted. + +Theorem normalizeRight : forall v left right merge, + mergeStates left (normalize v right) merge -> mergeStates left right merge. +Proof. admit. Admitted. + +Theorem normalizeHyp : forall state s b v, + realizeState state b s -> realizeState (normalize v state) b s. +Proof. + admit. +Admitted. + diff --git a/PEDANTIC/StateHypHelper.v b/PEDANTIC/StateHypHelper.v new file mode 100644 index 0000000..2a3c218 --- /dev/null +++ b/PEDANTIC/StateHypHelper.v @@ -0,0 +1,318 @@ +(********************************************************************************** + * The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic + * Traversal of Instruction Code) verification framework + * + * Developed by Kenneth Roe + * For more information, check out www.cs.jhu.edu/~roe + * + * SatSolverAux1.v + * This file contains the proof of correctness of a tree traversal algorithm using + * the PEDANTIC verification framework. + * + **********************************************************************************) + +Require Import Omega. +Require Export SfLib. +Require Export SfLibExtras. +Require Export ImpHeap. +Require Export AbsState. +Require Export AbsExecute. +Require Export AbsStateInstance. +Require Export Simplify. +Require Export Eqdep. +Require Export StateImplication. +Require Export Classical. +Require Export Unfold. +Require Export Fold. +Require Export merge. +Require Export ProgramTactics. +Require Export UpdateHelper. +Require Export ClosureHelper. +Require Export MagicWandExistsHelper. + +Set Printing Depth 200. + +Fixpoint isNat (v: @Value unit) := + match v with + | NatValue _ => True + | _ => False + end. + +Inductive ValueType := ListType | NatType | BoolType| AnyType. + +Fixpoint expValue (vt : ValueType) (ex : absExp) (bindings: list (@Value unit)) (e : env) : @Value unit := + match vt with + | NatType => match ex with + | AbsConstVal x => x + | AbsVar x => NatValue (e x) + | AbsQVar x => nth x bindings NoValue + | AbsFun AbsPlusId (x::y::nil) => match expValue NatType x bindings e, + expValue NatType y bindings e with + | NatValue a, NatValue b => NatValue (a+b) + | _, _ => NoValue + end + | AbsFun AbsMinusId (x::y::nil) => match expValue NatType x bindings e, + expValue NatType y bindings e with + | NatValue a, NatValue b => NatValue (a-b) + | _, _ => NoValue + end + | AbsFun AbsTimesId (x::y::nil) => match expValue ListType x bindings e, + expValue NatType y bindings e with + | ListValue a, NatValue b => nth b a NoValue + | _, _ => NoValue + end + | AbsFun AbsNthId (x::y::nil) => match expValue NatType x bindings e, + expValue NatType y bindings e with + | NatValue a, NatValue b => NatValue (a*b) + | _, _ => NoValue + end + | _ => NoValue + end + | ListType => match ex with + | AbsQVar x => nth x bindings NoValue + | _ => NoValue + end + | _ => NoValue + end. + +Fixpoint mergeConditions cond1 cond2 := + match cond1, cond2 with + | None, None => None + | Some x, None => Some x + | None, Some x => Some x + | Some x, Some y => Some (x /\ y) + end. +Fixpoint expValid (vt : ValueType) (ex : absExp) (bindings: list (@Value unit)) (e : env) : option Prop := + match vt with + | NatType => match ex with + | AbsConstVal _ => None + | AbsVar _ => None + | AbsQVar x => match nth x bindings NoValue with | NatValue _ => None | _ => Some False end + | AbsFun AbsPlusId (x::y::nil) => mergeConditions + (expValid vt x bindings e) + (expValid vt y bindings e) + | AbsFun AbsMinusId (x::y::nil) => mergeConditions + (expValid vt x bindings e) + (expValid vt y bindings e) + | AbsFun AbsTimesId (x::y::nil) => mergeConditions + (expValid vt x bindings e) + (expValid vt y bindings e) + | AbsFun AbsIteId (x::y::z::nil) => mergeConditions (mergeConditions + (expValid vt z bindings e) + (expValid vt y bindings e)) + (expValid BoolType x bindings e) + | _ => Some False + end + | AnyType => match ex with + | AbsConstVal _ => None + | AbsVar _ => None + | AbsQVar x => None + | _ => Some False + end + | _ => Some False + end. + +Fixpoint findTree (state : absState) (e: absExp) : option (absState) := + match state with + | AbsUpdateVar s a b => if hasVarExp e a then None else findTree s e + | AbsUpdateWithLoc s a b => if hasVarExp e a then None else findTree s e + | AbsStar a b => match findTree a e with + | Some x => Some x + | None => findTree b e + end + (*| AbsExistsT s => findTree s (N e)*) + | TREE(root,var,size,p) => if beq_absExp root e then Some (TREE(root,var,size,p)) else None + | ARRAY(root,a,b) => if beq_absExp root e then Some (ARRAY(root,a,b)) else None + | _ => None + end. + +Fixpoint expAssertion (ex : absExp) (bindings: list (@Value unit)) (e : env) := + match ex with + | AbsConstVal (NatValue (S _)) => True + | AbsConstVal _ => False + | AbsVar v => (e v) > 0 + | AbsQVar n => match nth n bindings NoValue with + | NatValue (S 0) => True + | _ => False + end + | AbsFun AbsLessId el => match map (absEval e bindings) el with + | (NatValue l::NatValue r::nil) => (l < r) + | _ => False + end + | AbsFun AbsEqualId el => match map (absEval e bindings) el with + | (NatValue l::NatValue r::nil) => (l = r) + | _ => False + end + | AbsFun AbsNotId (a::nil) => ~ (expAssertion a bindings e) + | AbsFun AbsAndId (a::b::nil) => (expAssertion a bindings e) /\ (expAssertion b bindings e) + | AbsFun AbsOrId (a::b::nil) => (expAssertion a bindings e) \/ (expAssertion b bindings e) + | AbsFun AbsMemberId (a::b::nil) => match expValid NatType a bindings e,expValue NatType a bindings e with + | None,NatValue x => match expValid AnyType b bindings e,expValue ListType b bindings e with + | None,y => Rmember x y=true + | Some p,y => p -> Rmember x y=true + end + | Some q,NatValue x => match expValid AnyType b bindings e,expValue ListType b bindings e with + | None,y => q -> Rmember x y=true + | Some p,y => q -> p -> Rmember x y=true + end + | _,_ => False + end + | AbsFun f el => match absEval e bindings ex with + | NatValue x => (x > 0) + | _ => False + end + end. + +Fixpoint isField (ff : nat) (l : list absExp) (bindings : list (@Value unit)) (st : state) := + match l with + | nil => false + | (h::r) => match expValue NatType h bindings (fst st) with + | NatValue q=> if beq_nat q ff then true else isField ff r bindings st + | _ => isField ff r bindings st + end + end. + +Fixpoint foldAssertions {t} (b : t) (a : list (t -> Prop)) := + match a with + | f::r => (f b) /\ foldAssertions b r + | nil => True + end. + +Fixpoint extractList {t} (l : @Value t) := + match l with + | ListValue v => v + | _ => nil + end. + +Fixpoint stateAssertions (s : absState) (st : state) := + match s with + | AbsStar a b => (stateAssertions a st)++(stateAssertions b st) + | AbsMagicWand a b => (stateAssertions a st)++(stateAssertions b st) + | AbsOrStar a b => (fun bindings => ((foldAssertions bindings (stateAssertions a st)) \/ (foldAssertions bindings (stateAssertions b st))))::nil + | AbsUpdateVar s a b => (fun bindings => (match expValid NatType b bindings (fst st),(NatValue (fst st a)=(expValue NatType b bindings (fst st))) with + | Some x,y => (x -> y) + | None,y => y + end))::(fun bindings => (exists vv, (foldAssertions bindings (stateAssertions s (override (fst st) a vv,snd st)))))::nil + | AbsUpdateWithLoc s l (AbsFun AbsPlusId (aa::bb::nil)) => + (fun bindings => (exists vv, (foldAssertions bindings (stateAssertions s (override (fst st) l vv,snd st))))):: + match findTree s aa with + | Some (ARRAY(_,s,v)) => (fun bindings => (expAssertion (AbsFun AbsLessId (bb::s::nil)) bindings (fst st) -> + forall ll vvv bbv, (NatValue ll=expValue NatType (AbsFun AbsPlusId (aa::bb::nil)) bindings (fst st) -> + (ListValue vvv)=expValue ListType v bindings (fst st) -> + NatValue bbv=expValue NatType bb bindings (fst st) -> + (NatValue (fst st l)=(nth (bbv+1) vvv NoValue))))) + | Some (TREE(_,v,s,ff)) => (fun bindings => (expAssertion (AbsFun AbsLessId (bb::s::nil)) bindings (fst st) -> + forall ll vvv bbv, (NatValue ll=expValue NatType (AbsFun AbsPlusId (aa::bb::nil)) bindings (fst st) -> + (ListValue vvv)=expValue ListType v bindings (fst st) -> + NatValue bbv=expValue NatType bb bindings (fst st) -> + isField ll ff bindings st=false -> + (NatValue (fst st l)=(nth (bbv+1) vvv NoValue)))) /\ + (expAssertion (AbsFun AbsLessId (bb::s::nil)) bindings (fst st) -> + forall ll vvv qq bbv, (NatValue ll=expValue NatType (AbsFun AbsPlusId (aa::bb::nil)) bindings (fst st) -> + (ListValue vvv)=expValue ListType v bindings (fst st) -> + isField ll ff bindings st=true -> + NatValue bbv=expValue NatType bb bindings (fst st) -> + (ListValue qq=(nth (bbv+1) vvv NoValue)) -> + NatValue (fst st l)=(nth 0 qq NoValue)))) + | _ => (fun bindings => True) + end::nil + | AbsExistsT s => (fun bindings => (exists v, (foldAssertions (v::bindings) (stateAssertions s st))))::nil + | AbsAll TreeRecords(v) s => map (fun (x : list Value -> Prop) => (fun bindings => forall vv vl, + expValue ListType v bindings (fst st)=vv-> + rangeSet vv=ListValue vl -> + forall v, (In (NatValue v) vl -> (x ((NatValue v)::bindings))))) (stateAssertions s st) + | AbsAll range(#ss,#ee) s => + map (fun (x : list Value -> Prop) => (fun bindings => forall v, (ss<=v -> v < ee -> x ((NatValue v)::bindings)))) (stateAssertions s st) + | AbsAll range(ss,ee) s => (map (fun (x : list Value -> Prop) => (fun bindings => forall sss eee, + expValue NatType ss bindings (fst st)=NatValue sss-> + expValue NatType ee bindings (fst st)=NatValue eee-> + forall v, (sss<=v -> v < eee -> x (bindings++((NatValue v)::nil))))) (stateAssertions s st)) + | AbsAll e s => map (fun (x : list Value -> Prop) => (fun bindings => forall vl, absEval (env_p st) bindings e = (ListValue vl) -> + forall v, (In v vl -> x (v::bindings)))) (stateAssertions s st) + | [x] => (fun bindings => (expAssertion x bindings (fst st)))::nil + | ARRAY(!!root,#count,v(n)) => (fun bindings => exists h, + (match (nth n bindings NoValue) with + | ListValue vl => anyHeapv ((fst st) root) count h vl /\ (forall x v, h x = Some v -> (snd st) x = Some v) + | _ => False + end))::nil + | ARRAY(root,count,v) => (fun bindings => (exists r c vv h, + NatValue r=expValue NatType root bindings (fst st) -> + NatValue c=expValue NatType count bindings (fst st) -> + ListValue vv=expValue ListType v bindings (fst st) -> + anyHeapv r c h vv))::nil + | (x |-> y) => (fun bindings => (exists xx, NatValue xx = expValue NatType x bindings (fst st)) /\ + (exists yy, NatValue yy = expValue NatType y bindings (fst st)) /\ + (forall xx yy, + NatValue xx = expValue NatType x bindings (fst st) -> + NatValue yy = expValue NatType y bindings (fst st) -> + (xx > 0 /\ (snd st xx)=Some yy)))::nil + | TREE(!!root,v(x),#count,(#next::nil)) => + (fun bindings => (exists h, + Tree (fst st root) count (next::nil) + (nth x bindings NoValue) h /\ (forall x v, h x = Some v -> (snd st) x = Some v)))::nil + | TREE(root,v,count,children) => (fun bindings => (forall c vr childrenr rootr countr, exists h, + childrenr = map (fun cc => expValue NatType cc bindings (fst st)) children -> + vr = expValue ListType v bindings (fst st) -> + NatValue countr = expValue NatType count bindings (fst st) -> + NatValue rootr = expValue NatType root bindings (fst st) -> + strip_nat_values childrenr c -> Tree rootr countr c vr h))::nil + + | _ => (fun x => True)::nil + end. + +Theorem stateAssertionThm: forall st b s, + realizeState st b s -> foldAssertions b (stateAssertions st s). +Proof. + admit. +Admitted. + +Theorem heapMap : forall t base size h l, @anyHeapv t base size h l -> (forall i, (i < size -> exists nv, (h (base+i)=Some nv /\ nth (i+1) l NoValue=NatValue nv))). +Proof. + admit. +Admitted. + +Theorem glue1 : forall (s : state), (let (x, _) := s in x)=env_p s. +Proof. + admit. +Admitted. + +Theorem glue2 : forall (s : state), (let (_, x) := s in x)=heap_p s. +Proof. + admit. +Admitted. + +Ltac decomposeStep := match goal with + | [ H: match ?Q with NatValue _ => _ | ListValue _ => False | NoValue => False | OtherValue _ => False end |- _ ] => remember Q; destruct Q + | [ H: match ?Q with NatValue _ => False | ListValue _ => _ | NoValue => False | OtherValue _ => False end |- _ ] => remember Q; destruct Q + | [ Q: False |- _ ] => inversion Q + end. + +Theorem rangeSetIsList : forall a b c d e, @Tree unit a b c d e -> exists v, @ListValue unit v=rangeSet d. +Proof. + admit. +Admitted. + +Theorem rootInTree : forall a b c d e f, @Tree unit a b c d e -> @ListValue unit f = rangeSet d -> In (NatValue a) f. +Proof. admit. Admitted. + +Theorem rootIsRecord: forall a b c d e, @Tree unit a b c d e -> extractList d = findRecord a d. +Proof. admit. Admitted. + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/Tactics.v b/PEDANTIC/Tactics.v index d77d1c4..e9541c9 100644 --- a/PEDANTIC/Tactics.v +++ b/PEDANTIC/Tactics.v @@ -13,6 +13,7 @@ Require Export SfLib. Require Export SfLibExtras. Require Export Coq.Logic.FunctionalExtensionality. +Require Import Omega. Theorem or_comm: forall a b, (a \/ b) -> (b \/ a). @@ -206,6 +207,7 @@ Ltac crunchStep := match goal with | [ |- _ -> _] => intros | [ H: In _ (_++_) |- _ ] => apply in_dist in H + | [ H: True |- _ ] => clear H | [ |- In _ (_++_) ] => apply in_split end. @@ -222,3 +224,6 @@ Ltac caseAnalysisStep := match goal with Ltac crunch := repeat crunchStep. Ltac caseAnalysis := (repeat caseAnalysisStep);crunch. + + + diff --git a/PEDANTIC/TreeTraversal (original).v b/PEDANTIC/TreeTraversal (original).v new file mode 100644 index 0000000..3295c7e --- /dev/null +++ b/PEDANTIC/TreeTraversal (original).v @@ -0,0 +1,1420 @@ +(********************************************************************************** + * The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic + * Traversal of Instruction Code) verification framework + * + * Developed by Kenneth Roe + * For more information, check out www.cs.jhu.edu/~roe + * + * TreeTraversal.v + * This file contains the proof of correctness of a tree traversal algorithm using + * the PEDANTIC verification framework. + * + **********************************************************************************) + +Require Import Omega. +Require Export SfLib. +Require Export SfLibExtras. +Require Export ImpHeap. +Require Export AbsState. +Require Export AbsExecute. +Require Export AbsStateInstance. +Require Export Simplify. +Require Export Eqdep. +Require Export StateImplication. +Require Export Classical. +Require Export Unfold. +Require Export Fold. +Require Export merge. +Require Export ProgramTactics. +Require Export ClosureHelper. +Require Export UpdateHelper. +Require Export MagicWandExistsHelper. +Require Export StateHypHelper. +Opaque basicEval. + +(* ************************************************************************** + * + * Here is the example from the paper. We start with some definitions for + * the variables in the program. + * + ***************************************************************************) + +Notation "'P'" := (Id 0) (at level 1). +Notation "'RR'" := (Id 1) (at level 1). +Notation "'I'" := (Id 2) (at level 1). +Notation "'N'" := (Id 3) (at level 1). +Notation "'T'" := (Id 4) (at level 1). +Notation "'Tmp_l'" := (Id 5) (at level 1). +Notation "'Tmp_r'" := (Id 6) (at level 1). + +(* + * Here is the abstract state condition at the beginning of the program. + * The \Sigma portion of the states that the variable RR points to a well + * formed tree. There are no predicates in the \Pi portion. + *) +Definition precondition : absState := + (AbsExistsT (TREE(!!RR,v(0),#2,(#0::#1::nil)))). + +(* + * This assertion is a little tricky. It is the invariant for the main + * loop of our example. We still have the assertion that RR points to a + * well formed tree. We also have two additional data structures in the + * heap. Both are linked lists. The first one is pointed to by the + * variable I and the second one is pointed to by the variable P. + * + * The \Pi portion in the assertion below states that the variable T + * is either nil or it points to a node inside the tree whose top is + * stored in RR. + * There is a second condition in \Pi which states that all of the + * cells in the list headed by P, the F_p field points to a node in the + * tree RR. This is the condition that uses the quantifiers in the \Pi + * portion. + *) + +Definition afterInitAssigns : absState := + (AbsExistsT (AbsExistsT (AbsExistsT + (TREE(!!RR,v(0),#2,(#0 :: #1 :: nil)) ** + TREE(!!I,v(1),#2,(#0::nil)) ** + TREE(!!P,v(2),#2,(#0::nil)) ** + (AbsAll (TreeRecords(v(1))) + ([nth(find(v(2),v(0)),#2) inTree v(1)])) ** + (AbsAll (TreeRecords(v(2))) + ([nth(find(v(3),v(0)),#2) inTree v(1)])) ** + ([ (!!T)====#0 \\// (!!T) inTree v(0)]))))). + +(* + * Here are the first three lines of code from the example + *) +Definition initCode : com := + I ::= A0; + T ::= !RR; + P ::= A0. + +(* + * ...and here is the proof that after these lines are executed, that + * we indeed have the state described by "afterInitAssigns". Actually, + * the state afterInitAssigns is a generalization of the actual state. + * Most of the proof involves simplifying the clauses after nil is filled + * in for the variables I and P and after T is replaced with RR. + *) +Theorem initialization : {{precondition}}initCode{{afterInitAssigns return nil with AbsNone}}. + +Proof. + (*unfold initCode. unfold afterInitAssigns. unfold precondition. + + eapply strengthenPost. + pcrunch. + + Focus 2. intros. inversion H. Focus 2. intros. inversion H. + + intros. + eapply stripUpdateVarHyp in H. Focus 2. compute. reflexivity. + simplifyHyp H. propagateExistsHyp H. + + stateImplication. clear H. + + simpl. intros. + + reduceHyp. reduceHyp. reduceHyp. reduceHyp. reduceHyp. reduceHyp. + reduceHyp. + Transparent basicEval. + simpl in H6. + simpl in H8. + simpl in H10. + Opaque basicEval. + inversion H6; subst; clear H6. inversion H8; subst; clear H8. + inversion H10; subst; clear H10. + reduceHyp. Focus 2. inversion H6; subst; clear H6. elim H8. reflexivity. + reduceHyp. Focus 2. inversion H3; subst; clear H3. elim H4. reflexivity. + reduceHyp. Focus 2. inversion H0; subst; clear H0. elim H1. reflexivity. + + reduceHypothesis. pcrunch. unfold env_p in *. + + erewrite composeEnvPropagate1 in HeqH1. Focus 2. apply H7. simpl in HeqH1. + erewrite composeEnvPropagate1 in HeqH0. Focus 2. apply H9. simpl in HeqH0. + erewrite composeEnvPropagate2 in HeqH0. Focus 2. apply H7. simpl in HeqH0. + erewrite composeEnvPropagate1 in HeqH10. Focus 2. apply H11. simpl in HeqH10. + erewrite composeEnvPropagate2 in HeqH10. Focus 2. apply H9. simpl in HeqH0. + erewrite composeEnvPropagate2 in HeqH10. Focus 2. apply H7. simpl in HeqH10. + erewrite composeEnvPropagate1 in HeqH0. Focus 2. apply H9. simpl in HeqH0. + erewrite composeEnvPropagate2 in HeqH0. Focus 2. apply H7. simpl in HeqH0. + subst. eapply ex_intro. + instantiate (1 := (_::_::_::_::nil)). + + decomposeTheState. + eapply RSEmpty. unfold empty_heap. simpl. reflexivity. + simpl. rewrite HeqH10. eapply BStateTree. pcrunch. eapply TreeBase. + omega. unfold empty_heap. simpl. reflexivity. + eapply SNVCons. eapply SNVNil. + simpl. rewrite HeqH1. eapply BStateTree. pcrunch. eapply TreeBase. + omega. unfold empty_heap. simpl. reflexivity. + eapply SNVCons. eapply SNVNil. + eapply RSAll. simpl. reflexivity. Transparent basicEval. simpl. Opaque basicEval. + reflexivity. intros. inversion H0. + eapply RSAll. simpl. reflexivity. Transparent basicEval. simpl. Opaque basicEval. + reflexivity. intros. inversion H0. + Transparent basicEval. simpl. Opaque basicEval. + + remember (e T). destruct n. simpl. eapply BTStatePredicate. + omega. unfold empty_heap. simpl. reflexivity. + simpl. instantiate (1 := nth 0 b NoValue). erewrite rootIsMember. + eapply BTStatePredicate. omega. unfold empty_heap. simpl. reflexivity. + omega. rewrite HeqH0. + erewrite composeEnvPropagate2 in H15. Focus 2. apply H11. + erewrite composeEnvPropagate2 in H15. Focus 2. apply H9. + erewrite composeEnvPropagate2 in H15. Focus 2. apply H7. simpl in H15. + apply H15.*) + admit. +Admitted. + + +(* + * Now we define the abstract state that should exist after the while of + * the main body of the program is executed. + * + * This is exactly the same as the state afterInitAssigns except that the + * condition T=0 and I=0 have been added. + *) +Definition afterWhile : absState := + (AbsExistsT (AbsExistsT (AbsExistsT + (TREE(!!RR,v(0),#2,(#0::#1::nil)) ** + TREE(!!I,v(1),#2,(#0::nil)) ** + TREE(!!P,v(2),#2,(#0::nil)) ** + (AbsAll (TreeRecords(v(2))) + ([nth(find(v(3),v(0)),#2) inTree v(1)])) ** + [(!!T)====#0])))). + +Definition loopInv : absState := + (AbsExistsT (AbsExistsT (AbsExistsT + (TREE(!!RR,v(0),#2,(#0::#1::nil)) ** + TREE(!!I,v(1),#2,(#0::nil)) ** + TREE(!!P,AbsQVar 2,#2,(#0::nil)) ** + (AbsAll (TreeRecords(v(1))) + ([nth(find(v(2),v(0)),#2) inTree v(1)])) ** + (AbsAll (TreeRecords(v(2))) + ([nth(find(v(3),v(0)),#2) inTree v(1)])) ** + ([(!!T)====#0 \\// (!!T) inTree v(0)]))))). +(* + * Here is the code for the main loop of the program. + *) +Definition loop : com := + WHILE ALnot (!T === A0) DO + N ::= !P; + NEW P,ANum(2); + (CStore ((!P)+++(ANum 1)) (!T)); + (CStore ((!P)+++(ANum 0)) (!N)); + (CLoad Tmp_l ((!T)+++ANum(0))); + (CLoad Tmp_r ((!T)+++ANum(1))); + (CIf (ALand (!Tmp_l === A0) (!Tmp_r === A0)) + (CIf (!I === A0) + (T ::= A0) + ( (CLoad T ((!I)+++ANum(1))); + (CLoad Tmp_l ((!I)+++ANum(0))); + DELETE !I,ANum(2); + I ::= (!Tmp_l))) + + (CIf (!Tmp_l === A0) + (CLoad T ((!T)+++ANum(1))) + (CIf (!Tmp_r === A0) + (CLoad T ((!T)+++ANum(0))) + (N ::= !I; + NEW I,ANum(2); + (CStore ((!I)+++ANum(0)) (!N)); + (CLoad Tmp_l ((!T)+++(ANum 1))); + (CStore ((!I)+++ANum(1)) (!Tmp_l)); + (CLoad T ((!T)+++(ANum 0))))))) + LOOP. + +Opaque basicEval. + + + +Theorem treeRef1 : forall s n, +(realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) nil s) -> + NatValue n = basicEval I (NatValue (env_p s P) :: NatValue 1 :: nil) -> + heap_p s n <> None. +Proof. + (*intros s n H H0. eapply stripUpdateVarHypp in H. vm_compute in H. + simpl in H0. Transparent basicEval. unfold basicEval in H0. + inversion H0; subst; clear H0. + eapply stateAssertionThm in H. simpl in H. crunch. + destruct s. simpl. inversion H0; subst; clear H0. erewrite H10. Focus 2. + simpl. reflexivity. Focus 2. reflexivity. + intro X. inversion X.*) + admit. +Admitted. + + +Theorem treeRef2 : forall s n, (realizeState + (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) nil s) -> NatValue n = basicEval I + (NatValue (env_p s P) :: NatValue 0 :: nil) -> heap_p s n <> None. +Proof. + (*intros s n H H0. + eapply stripUpdateVarHypp in H. vm_compute in H. + simplifyHyp H. + eapply removeUpdateLocHyp in H. Focus 2. compute. reflexivity. + simpl in H0. Transparent basicEval. unfold basicEval in H0. + inversion H0; subst; clear H0. + eapply stateAssertionThm in H. simpl in H. crunch. + assert (forall x, x+0=x). + intros. induction x9. simpl. reflexivity. simpl. rewrite IHx9. reflexivity. + rewrite H1. + destruct s. simpl. simpl in H10. inversion H0; subst; clear H0. erewrite H10. Focus 2. + reflexivity. Focus 2. reflexivity. + intro X. inversion X.*) admit. +Admitted. + + +Theorem existsRealizeState : + forall st st' b s, + (realizeState st b s -> realizeState st' b s) -> + (exists s, realizeState st b s) -> + (exists s, realizeState st' b s). +Proof. + admit. +Admitted. + +Theorem deleteExists1 : forall x, (realizeState + (AbsUpdateWithLoc (AbsUpdateWithLoc ([~~ !! (I) ==== # 0] ** + [!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (I) ++++ # 1) Tmp_l !! + (I) ++++ # 0) nil x) -> exists s, (realizeState + (AbsMagicWand (AbsUpdateWithLoc (AbsUpdateWithLoc ([~~ !! (I) ==== # 0] ** + [!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! + (P) !! (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (I) ++++ # 1) Tmp_l !! + (I) ++++ # 0) (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (I) ==== v( 0)]))))) nil s). +Proof. + (*intros x H0. + Set Printing Depth 200. + propagateExistsHyp H0. propagateExistsHyp H0. + simplifyHyp H0. eapply stripUpdateVarHypp in H0. vm_compute in H0. + simplifyHyp H0. + simplifyHyp H0. propagateExistsHyp H0. + propagateExistsHyp H0. propagateExistsHyp H0. + eapply stripUpdateWithLocHypp in H0. compute in H0. + eapply unfold_rs2 in H0. Focus 2. unfoldHeap (!!I). + simplifyHyp H0. simplifyHyp H0. simplifyHyp H0. + eapply removeUpdateLocHyp in H0. Focus 2. compute. reflexivity. + eapply removeUpdateLocHyp in H0. Focus 2. compute. reflexivity. + eapply stripUpdateWithLocHypp in H0. compute in H0. + eapply stripUpdateWithLocHypp in H0. compute in H0. + simplifyHyp H0. + propagateExistsHyp H0. + eapply existsRealizeState. + intros. + propagateExists. propagateExists. simplify. simplify. + eapply stripUpdateVarp. compute. eapply stripUpdateVarp. compute. + simplify. simplify. propagateExists. + eapply stripUpdateWithLocp. compute. + eapply unfold_rs1. unfoldHeap (!!I). + simplify. + simplify. simplify. simplify. propagateExists. simplify. + eapply removeUpdateLocThm. compute. reflexivity. + eapply removeUpdateLocThm. compute. reflexivity. + eapply stripUpdateWithLocp. compute. + eapply stripUpdateWithLocp. compute. + simplify. propagateExists. + apply H. + eapply magicWandStateExists. + compute. reflexivity. + eapply ex_intro. apply H0. + compute. reflexivity. + compute. reflexivity. + compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsId. reflexivity. + compute. reflexivity. + intros. + compute in H. + eapply stateAssertionThm in H. simpl in H. crunch. + + destruct s. simpl in H. simpl. remember (e I). + destruct n. inversion H. exists n. reflexivity. *) + admit. +Admitted. + +Opaque mergeStates. + +Theorem mergeTheorem1: +mergeStates + (AbsUpdateVar ([!! (I) ==== # 0] ** + [!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T # 0) + + (AbsUpdateVar + (AbsMagicWand (AbsUpdateWithLoc (AbsUpdateWithLoc ([~~ !! (I) ==== # 0] ** + [!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! + (P) !! (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (I) ++++ # 1) Tmp_l !!(I) ++++ # 0) (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (I) ==== v( 0)]))))) I !! (Tmp_l)) + + (AbsExistsT (AbsExistsT (AbsExistsT + (TREE(!!RR,v(0),#2,(#0::#1::nil)) ** + TREE(!!I,v(1),#2,(#0::nil)) ** + TREE(!!P,AbsQVar 2,#2,(#0::nil)) ** + (AbsAll (TreeRecords(v(1))) + ([nth(find(v(2),v(0)),#2) inTree v(1)])) ** + (AbsAll (TreeRecords(v(2))) + ([nth(find(v(3),v(0)),#2) inTree v(1)])) ** + ([(!!T)====#0 \\// (!!T) inTree v(0)]))))). +Proof. + (*Set Printing Depth 200. + eapply stripUpdateVarLeft. compute. reflexivity. + eapply stripUpdateVarRight. compute. reflexivity. + mergePropagateExistsLeft. mergePropagateExistsRight. + eapply removeUpdateLocLeft. compute. reflexivity. + eapply removeUpdateLocLeft. compute. reflexivity. + eapply removeUpdateLocRight. compute. reflexivity. + eapply removeUpdateLocRight. compute. reflexivity. + mergeSimplifyLeft. mergeSimplifyRight. + eapply unfold_merge2. unfoldHeap (v(5)). + mergeSimplifyRight. + eapply stripUpdateWithLocRight. compute. reflexivity. + mergeSimplifyRight. mergePropagateExistsRight. + eapply stripUpdateWithLocRight. compute. reflexivity. + eapply mergeStripVarInsideRight. instantiate (1 := Tmp_l). compute. reflexivity. + eapply stripUpdateWithLocRight. compute. reflexivity. + mergeSimplifyRight. mergePropagateExistsRight. + eapply localizeExistsRightp. compute. + eapply localizeExistsRightp. compute. + eapply localizeExistsRightp. compute. + eapply removeMagicWandRight. compute. reflexivity. + mergeSimplifyRight. mergeSimplifyRight. + eapply mergeStripVarRight. instantiate (1 := Tmp_r). compute. reflexivity. + eapply mergeStripVarLeft. instantiate (1 := Tmp_l). compute. reflexivity. + eapply mergeStripVarLeft. instantiate (1 := Tmp_r). compute. reflexivity. + eapply normalizeRight. instantiate (1 := (I)). compute. + mergeSimplifyRight. mergePropagateExistsRight. + eapply normalizeRight. instantiate (1 := (I)). compute. + + eapply mergeImplies. + + startMerge. + + doMergeStates. + + eapply DMOrPredicates2. compute. + eapply PESComposeRight. eapply PESComposeRight. eapply PESComposeRight. + eapply PESComposeLeft. eapply PESComposeRight. eapply PESComposeLeft. eapply PESR. + eapply PESComposeLeft. eapply PESComposeLeft. eapply PESComposeRight. + eapply PESComposeLeft. eapply PESComposeRight. eapply PESComposeRight. + eapply PESComposeRight. eapply PESComposeRight. eapply PESComposeRight. + eapply PESComposeRight. eapply PESComposeLeft. eapply PESComposeLeft. + eapply PESR. compute. reflexivity. + finishMerge. + + intros. + eapply foldHeapTheorem in H. Focus 2. foldHeap (!!P) (0::nil) 2. + eapply foldAllTheorem in H. Focus 2. foldAll 2. + simplifyHyp H. simplifyHyp H. simplify. + eapply stateImplication. apply H. compute. reflexivity. compute. reflexivity. + prove_implication. compute. reflexivity. compute. reflexivity. simpl. + intros. eapply ex_intro. + eapply emptyRealizeState. simpl. reflexivity. + + intros. compute in H. + eapply stateAssertionThm in H. simpl in H. crunch. + remember (nth 5 bindings NoValue). destruct y. + destruct n. inversion H. exists n. reflexivity. inversion H. inversion H. inversion H.*) + admit. +Admitted. + + (*eapply FoldAll. compute. reflexivity. compute. reflexivity. solveSPickElement. + solveSPickElement. instantiate (3 := (2)). solveSPickElement. stripFields. + compute. reflexivity. compute. reflexivity. solveSPickElement. compute. reflexivity.*) + (*foldAll 0. + eapply FoldAll. + foldAll 1.*) + (*eapply FoldHeap. instantiate (2 := ((#0)::nil)). stripFields. + compute. reflexivity. (instantiate (2 := (!!P))). + instantiate (2 := 2). pickNCells. pickNHeaps. compute. reflexivity. eapply PNCInductive. solveSPickElement. + eapply PNCInductive0. solveSPickElement. eapply PNCBase. pickNHeaps. + eapply SFCons. eapply SFNil. simpl. reflexivity. + Focus 2. simpl. reflexivity. + Focus 5. simpl.*) + + (*eapply normalizeHyp in H. instantiate (1 := P).*) + +Theorem storeCheck1 : forall s n, realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (I) ==== v( 0)] ** + AbsUpdateVar ([~~ !! (Tmp_r) ==== # 0] ** + [~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( v( 7), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! + (P) !! (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) N v( 1)))))) nil s -> NatValue n = basicEval I + (NatValue (env_p s I) :: NatValue 0 :: nil) -> heap_p s n <> None. +Proof. + (*Set Printing Depth 1000. + intros s n H H0. + eapply stripUpdateVarHyp in H. Focus 2. compute. reflexivity. + simplifyHyp H. + eapply stateAssertionThm in H. simpl in H. crunch. + + destruct s. Transparent basicEval. simpl. simpl in H9. simpl in H0. + + assert (forall x, x + 0=x). + induction x5. simpl. reflexivity. simpl. rewrite IHx5. reflexivity. + assert ((e I) > 0 /\ h (e I) = Some (e N)). + eapply H9. reflexivity. reflexivity. inversion H3; subst; clear H3. rewrite H2 in H0. + inversion H0; subst; clear H0. + + remember (e I). rewrite H7. + intro X. inversion X.*) + admit. +Admitted. + +Set Printing Depth 1000. + +Theorem storeCheck2 : forall s n, + (realizeState + (AbsUpdateWithLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (I) ==== v( 0)] ** + AbsUpdateVar ([~~ !! (Tmp_r) ==== # 0] ** + [~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( v( 7), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! + (P) !! (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) N v( 1)))))) !! + (I) ++++ # 0 !! (N)) Tmp_l !! (T) ++++ # 1) nil s +) -> + (NatValue n = basicEval I (NatValue + (env_p s I) :: NatValue 1 :: nil)) -> + heap_p s n <> None. +Proof. + (*Set Printing Depth 1000. + intros s n H H0. + + eapply stripUpdateVarHyp in H. Focus 2. compute. reflexivity. + simplifyHyp H. + simplifyHyp H. propagateExistsHyp H. propagateExistsHyp H. + propagateExistsHyp H. propagateExistsHyp H. propagateExistsHyp H. + propagateExistsHyp H. + eapply removeUpdateLocHyp in H. Focus 2. simpl. reflexivity. + eapply stripUpdateWithLocHypp in H. compute in H. + eapply stateAssertionThm in H. simpl in H. crunch. + + destruct s. Transparent basicEval. simpl. simpl in H0. simpl in H19. + + assert ((e I) + 1 > 0 /\ h ((e I)+1) = Some x6). + eapply H19. unfold override. simpl. reflexivity. reflexivity. inversion H; subst; clear H. inversion H0; subst; clear H0. + + rewrite H3. intro X. inversion X.*) + + admit. +Admitted. +Fixpoint findInTree (v : absExp) (s : absState) : option (absExp * absState) := + match s with + | AbsStar a b => match findInTree v a with + | Some (t,a') => Some (t, AbsStar a' b) + | None => match findInTree v b with + | Some (t,b') => Some(t,AbsStar a b') + | None => None + end + end + | [ (vv inTree x)] => if beq_absExp v vv then Some (x,AbsEmpty) else None + | _ => None + end. + +Fixpoint findTheTree (v : absExp) (s : absState) : option absState := + match s with + | AbsStar a b => match findTheTree v a with + | Some a' => Some a' + | None => match findTheTree v b with + | Some b' => Some b' + | None => None + end + end + | (TREE(r,d,n,f)) => if beq_absExp d v then Some (TREE(r,d,n,f)) else None + | _ => None + end. + +Fixpoint propagateLoc2 (v : id) (e : absExp) (s : absState) := + match e with + | ((x)++++(#n)) => match findInTree x s with + | None => None + | Some (tf,s') => match findTheTree tf s' with + | Some (TREE(ee,vv,nn,f)) => if mem_absExp (#n) f then (if hasVarState s' v then + match (substVarState (addStateVar 0 s') v v(0)) with + | Some xx => Some (AbsStar (AbsExistsT xx) (if hasVarExp x v then ([(!!v) inTree (substVar (addExpVar 0 vv) v v(0)) \\// (!!v)====(#0)]) else ([(!!v) inTree (substVar (addExpVar 0 vv) v v(0)) \\// (!!v)====(#0)] ** [x inTree vv]))) + | _ => None + end + else + Some (AbsStar s' (if hasVarExp x v then ([(!!v) inTree vv \\// (!!v)====(#0)]) else ([(!!v) inTree vv \\// (!!v)====(#0)] ** [x inTree vv])))) else None + | _ => None + end + end + | (x) => match findInTree x s with + | None => None + | Some (tf,s') => match findTheTree tf s' with + | Some (TREE(ee,vv,nn,f)) => if mem_absExp (#0) f then (if hasVarState s' v then + match (substVarState (addStateVar 0 s') v v(0)) with + | Some xx => Some (AbsStar (AbsExistsT xx) (if hasVarExp x v then ([(!!v) inTree (substVar (addExpVar 0 vv) v v(0)) \\// (!!v)====(#0)]) else ([(!!v) inTree (substVar (addExpVar 0 vv) v v(0)) \\// (!!v)====(#0)] ** [x inTree vv]))) + | _ => None + end + else + Some (AbsStar s' (if hasVarExp x v then ([(!!v) inTree vv \\// (!!v)====(#0)]) else ([(!!v) inTree vv \\// (!!v)====(#0)] ** [x inTree vv])))) else None + | _ => None + end + end + end. + +Fixpoint propagateLoc (v : id) (e : absExp) (s : absState) := + match e with + | ((x)++++(#n)) => match findInTree x s with + | None => None + | Some (tf,s') => match findTheTree tf s' with + | Some (TREE(ee,vv,nn,f)) => if mem_absExp (#n) f then (if hasVarState s' v then None else Some (AbsStar s' (if hasVarExp x v then ([(!!v) inTree vv \\// (!!v)====(#0)]) else ([(!!v) inTree vv \\// (!!v)====(#0)] ** [x inTree vv])))) else None + | _ => None + end + end + | (x) => match findInTree x s with + | None => None + | Some (tf,s') => match findTheTree tf s' with + | Some (TREE(ee,vv,nn,f)) => if mem_absExp (#0) f then (if hasVarState s' v then None else Some (AbsStar s' (if hasVarExp x v then ([(!!v) inTree vv \\// (!!v)====(#0)]) else ([(!!v) inTree vv \\// (!!v)====(#0)] ** [x inTree vv])))) else None + | _ => None + end + end + end. + +Fixpoint removeUpdateWithLocTraverse2 (s : absState) : absState := + match s with + | AbsUpdateWithLoc s i v => match propagateLoc2 i v s with + | Some s' => s' + | None => AbsUpdateWithLoc (removeUpdateWithLocTraverse2 s) i v + end + | AbsStar l r => AbsStar (removeUpdateWithLocTraverse2 l) (removeUpdateWithLocTraverse2 r) + | AbsUpdateLoc s i v => AbsUpdateLoc (removeUpdateWithLocTraverse2 s) i v + | AbsUpdateVar s i v => AbsUpdateVar (removeUpdateWithLocTraverse2 s) i v + | AbsExistsT s => AbsExistsT (removeUpdateWithLocTraverse2 s) + | x => x + end. + +Fixpoint removeUpdateWithLocTraverse (s : absState) : absState := + match s with + | AbsUpdateWithLoc s i v => match propagateLoc i v s with + | Some s' => s' + | None => AbsUpdateWithLoc (removeUpdateWithLocTraverse s) i v + end + | AbsStar l r => AbsStar (removeUpdateWithLocTraverse l) (removeUpdateWithLocTraverse r) + | AbsUpdateLoc s i v => AbsUpdateLoc (removeUpdateWithLocTraverse s) i v + | AbsUpdateVar s i v => AbsUpdateVar (removeUpdateWithLocTraverse s) i v + | AbsExistsT s => AbsExistsT (removeUpdateWithLocTraverse s) + | x => x + end. + +Theorem removeUpdateWithLocTraverseLeft : forall l r m, + mergeStates (removeUpdateWithLocTraverse l) r m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Theorem removeUpdateWithLocTraverseRight : forall l r m, + mergeStates l (removeUpdateWithLocTraverse r) m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Theorem removeUpdateWithLocTraverseLeft2 : forall l r m, + mergeStates (removeUpdateWithLocTraverse2 l) r m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Theorem removeUpdateWithLocTraverseRight2 : forall l r m, + mergeStates l (removeUpdateWithLocTraverse2 r) m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Fixpoint getConstraints (s : absState) : list absState := + match s with + | AbsStar a b => (getConstraints a)++(getConstraints b) + | ([x]) => ([x])::nil + | _ => nil + end. + +Fixpoint stripStates v (l : list absState) := + match l with + | nil => nil + | (a::b) => if hasVarState a v then stripStates v b else a::(stripStates v b) + end. + +Fixpoint mapRelevantConstraints (v : id) (v' : id) (l : list absState) := + match l with + | (f::r) => if hasVarState f v then (replaceStateExp (!!v) (!!v') f)::(mapRelevantConstraints v v' r) else (mapRelevantConstraints v v' r) + | nil => nil + end. + +Fixpoint findPromoteConstraints (v : id) (e : absExp) (s : absState) (l : list absState) : list absState := + match s with + | AbsStar a b => (findPromoteConstraints v e a ((getConstraints b)++l))++(findPromoteConstraints v e b ((getConstraints a)++l)) + | AbsUpdateVar s i vv => stripStates i (findPromoteConstraints v e s (stripStates i l)) + | AbsUpdateWithLoc s i vv => if beq_absExp e vv then (mapRelevantConstraints i v l) else stripStates i (findPromoteConstraints v e s (stripStates i l)) + | _ => nil + end. + +Fixpoint fold_star l root := + match l with + | nil => root + | (a::b) => fold_star b (root ** a) + end. + +Fixpoint promoteConstraints (s : absState) : absState := + match s with + | AbsUpdateWithLoc s i v => fold_star (findPromoteConstraints i v s nil) (AbsUpdateWithLoc (promoteConstraints s) i v) + | AbsStar l r => AbsStar (promoteConstraints l) (promoteConstraints r) + | AbsUpdateLoc s i v => AbsUpdateLoc (promoteConstraints s) i v + | AbsUpdateVar s i v => AbsUpdateVar (promoteConstraints s) i v + | AbsExistsT s => AbsExistsT (promoteConstraints s) + | x => x + end. + +Theorem promoteConstraintsLeft : forall l r m, + mergeStates (promoteConstraints l) r m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Theorem promoteConstraintsRight : forall l r m, + mergeStates l (promoteConstraints r) m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Fixpoint findCell (l : absExp) (s: absState) : option (absState * absState) := + match s with + | AbsStar a b => match findCell l a with + | Some (x,y) => Some(x, AbsStar y b) + | None => match findCell l b with + | Some (x,y) => Some (x, AbsStar a y) + | None => None + end + end + | (x |-> y) => if beq_absExp l x then Some ((x |-> y),AbsEmpty) else None + | _ => None + end. + + +Theorem mergeTheorem2: +mergeStates + (AbsUpdateWithLoc ([!! (Tmp_r) ==== # 0] ** + [~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (T) ++++ # 0) (AbsUpdateWithLoc + (AbsUpdateLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (I) ==== v( 0)] ** + AbsUpdateVar ([~~ !! (Tmp_r) ==== # 0] ** + [~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( v( 7), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! + (P) !! (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) N v( 1)))))) !! + (I) ++++ # 0 !! (N)) Tmp_l !! (T) ++++ # 1) !! (I) ++++ # 1 !! (Tmp_l)) T !! + (T) ++++ # 0) + + (AbsUpdateWithLoc ( + [~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) |-> v( 1) ** + AbsExistsT + (AbsUpdateVar ([!! (P) ==== v( 1)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (TREE( !! (RR), v(0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 0), v( 2), # 2, # 0 :: nil) ** + [!! (T) inTree !! (P)])) N v( 0)))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (T) ++++ # 0). +Proof. + eapply mergeImplies. + mergeSimplifyLeft. mergeSimplifyRight. + eapply stripUpdateVarLeft. compute. reflexivity. + eapply stripUpdateVarRight. compute. reflexivity. + mergePropagateExistsLeft. mergePropagateExistsRight. + eapply removeUpdateLocLeft. compute. reflexivity. + eapply removeUpdateLocLeft. compute. reflexivity. + eapply removeUpdateLocRight. compute. reflexivity. + eapply removeUpdateLocRight. compute. reflexivity. + eapply removeUpdateLocRight. compute. reflexivity. + eapply promoteConstraintsRight. compute. + eapply stripUpdateWithLocRight. compute. reflexivity. + eapply mergeStripVarRight. instantiate (1 := Tmp_r). compute. reflexivity. + eapply mergeStripVarLeft. instantiate (1 := Tmp_l). compute. reflexivity. + eapply mergeStripVarLeft. instantiate (1 := Tmp_r). compute. reflexivity. + mergeSimplifyRight. + eapply mergeStripVarInsideRight. instantiate (1 := Tmp_l). compute. reflexivity. + eapply removeUpdateWithLocTraverseRight. compute. + eapply removeUpdateLocRight. compute. reflexivity. + mergeSimplifyRight. mergeSimplifyRight. + eapply stripUpdateVarRight. compute. reflexivity. + eapply mergeSimplifyRight. compute. reflexivity. + eapply removeUpdateWithLocTraverseRight2. compute. + mergeSimplifyRight. + admit. +Admitted. + +Theorem mergeTheorem3: +mergeStates + (AbsUpdateWithLoc ([!! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) |-> v( 1) ** + AbsExistsT + (AbsUpdateVar ([!! (P) ==== v( 1)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (TREE( !! (RR), !! (P), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 3), # 2, # 0 :: nil) ** + TREE( v( 0), v( 4), # 2, # 0 :: nil) ** + [!! (T) inTree !! (P)])) N v( 0)))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (T) ++++ # 1) (AbsUpdateWithLoc + ([~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) |-> v( 1) ** + AbsExistsT + (AbsUpdateVar ([!! (P) ==== v( 1)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (TREE( !! (RR), !! (P), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 3), # 2, # 0 :: nil) ** + TREE( v( 0), v( 4), # 2, # 0 :: nil) ** + [!! (T) inTree !! (P)])) N v( 0)))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (T) ++++ # 0) + + ([~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) |-> v( 1) ** + AbsExistsT + (AbsUpdateVar ([!! (P) ==== v( 1)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (TREE( !! (RR), !! (P), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 3), # 2, # 0 :: nil) ** + TREE( v( 0), v( 4), # 2, # 0 :: nil) ** + [!! (T) inTree !! (P)])) N v( 0)))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1). +Proof. + admit. +Admitted. + +Theorem mergeTheorem4: +mergeStates + (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 1), v( 3)), # 2) inTree v( 0)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 2), v( 3)), # 2) inTree v( 0)]) ** + [!! (T) ==== # 0 \\// !! (T) inTree v( 0)])))) ([~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) |-> v( 1) ** + AbsExistsT + (AbsUpdateVar ([!! (P) ==== v( 1)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (TREE( !! (RR), !! (P), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 3), # 2, # 0 :: nil) ** + TREE( v( 0), v( 4), # 2, # 0 :: nil) ** + [!! (T) inTree !! (P)])) N v( 0)))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) + + (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 1), v( 3)), # 2) inTree v( 0)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 2), v( 3)), # 2) inTree v( 0)]) ** + [!! (T) ==== # 0 \\// !! (T) inTree v( 0)])))). +Proof. + admit. +Admitted. + +Theorem implication1: +forall s : state, realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 1), v( 3)), # 2) inTree v( 0)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 2), v( 3)), # 2) inTree v( 0)]) ** + [!! (T) ==== # 0 \\// !! (T) inTree v( 0)])))) nil s -> realizeState (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 1), v( 3)), # 2) inTree v( 0)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 2), v( 3)), # 2) inTree v( 0)]) ** + [!! (T) ==== # 0 \\// !! (T) inTree v( 0)])))) nil s. +Proof. + admit. +Admitted. + +Theorem implication2: +forall x : state, realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 1), v( 3)), # 2) inTree v( 0)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 2), v( 3)), # 2) inTree v( 0)]) ** + [!! (T) ==== # 0 \\// !! (T) inTree v( 0)])))) nil x -> realizeState loopInv nil x. +Proof. + admit. +Admitted. + +Theorem implication3: +forall s : state, realizeState + ([~~ (convertToAbsExp (ALnot (! T === A0)))] ** + loopInv) nil s -> realizeState (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 2), v( 3)), # 2) inTree v( 0)]) ** + [!! (T) ==== # 0])))) nil s. +Proof. + admit. +Admitted. + +Theorem loopInvariant : + {{afterInitAssigns}}loop{{afterWhile return nil with AbsNone}}. +Proof. + (* Break up the while portion of the loop *) + unfold loop. unfold afterWhile. unfold afterInitAssigns. + + (* WHILE ALnot (!T === A0) DO *) + eapply strengthenPost. + eapply whileThm with (invariant := loopInv). unfold loopInv. + eapply strengthenPost. simpl. + + (* N ::= !P; *) + eapply compose. pcrunch. + + (* NEW P,ANum(Size_l);*) + eapply compose. pcrunch. + + simp. simp. simp. + + (*assert (simplifyState (nil : list (Context)) + ((v(0) ++++ #0 |-> v(1) ** + [!!(P) ==== v(0)]):absState)=AbsEmpty). simpl. + + assert (buildStateContext ([!!(P)====v(0)]:absState)=buildStateContext (AbsEmpty)). + simpl.*) + + (* CStore ((!P)+++(ANum F_p)) (!T)) *) + eapply compose. pcrunch. + apply treeRef1. apply H. apply H0. + + + (* CStore ((!P)+++(ANum F_n)) (!N)) *) + eapply compose. pcrunch. + apply treeRef2. apply H. apply H0. + + simp. + + (* CLoad Tmp_l ((!T)+++ANum(F_l)) *) + eapply compose. pcrunch. + + (* CLoad Tmp_r ((!T) +++ A1) *) + eapply compose. pcrunch. + + (* IF (ALand (!Tmp_l === A0) (!Tmp_r === A0)) *) + eapply if_statement. simpl. + + (* IF (!I === A0) *) + eapply if_statement. simpl. + + (* T ::= A0 *) + pcrunch. + + (* ELSE *) + + (* CLoad T (!I)++A1 *) + eapply compose. pcrunch. + + (* CLoad Tmp_l (!I)++A0 *) + eapply compose. pcrunch. + + (* DELETE !I, A2 *) + eapply compose. + Set Printing Depth 200. pcrunch. + eapply deleteExists1. apply H0. + + (* I ::= !Tmp_l *) + pcrunch. + + pcrunch. pcrunch. pcrunch. pcrunch. + + (* FI *) + apply mergeTheorem1. + + (* (CIf (!Tmp_l === A0) *) + simpl. + eapply if_statement. + + (* CLoad T (!T +++ A1) *) + simpl. pcrunch. + + (* ELSE *) + + (* CIf (!Tmp_r === A0) *) + simpl. eapply if_statement. + + (* CLoad T (!T +++ A0) *) + simpl. pcrunch. + + (* ELSE *) + + (* N ::= !I *) + simpl. eapply compose. pcrunch. + + (* NEW I, A2 *) + eapply compose. pcrunch. + + (* CStore (I ++++ A0) (!N) *) + eapply compose. pcrunch. + apply storeCheck1. apply H. apply H0. + + (* CLoad Tmp_l (! T +++ A1) *) + eapply compose. pcrunch. + + (* CStore (! I +++ A1) (! Tmp_l) *) + eapply compose. pcrunch. + apply storeCheck2. apply H. apply H0. + + (* (CLoad T (! T +++ A0) *) + pcrunch. + + (* FI *) + Set Printing Depth 2000. + pcrunch. pcrunch. pcrunch. pcrunch. pcrunch. pcrunch. + apply mergeTheorem2. + + (* FI *) + pcrunch. + apply mergeTheorem3. + + (* FI *) + pcrunch. + apply mergeTheorem4. + + pcrunch. pcrunch. pcrunch. pcrunch. pcrunch. pcrunch. + + apply implication1. + + intros. inversion H. + intros. inversion H. + + apply implication2. + apply implication3. + + intros. apply H. + intros. inversion H. + +Admitted. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/TreeTraversal.v b/PEDANTIC/TreeTraversal.v index 3e97d5c..ef53101 100644 --- a/PEDANTIC/TreeTraversal.v +++ b/PEDANTIC/TreeTraversal.v @@ -11,6 +11,7 @@ * **********************************************************************************) +Require Import Omega. Require Export SfLib. Require Export SfLibExtras. Require Export ImpHeap. @@ -25,6 +26,10 @@ Require Export Unfold. Require Export Fold. Require Export merge. Require Export ProgramTactics. +Require Export ClosureHelper. +Require Export UpdateHelper. +Require Export MagicWandExistsHelper. +Require Export StateHypHelper. Opaque basicEval. (* ************************************************************************** @@ -47,7 +52,7 @@ Notation "'Tmp_r'" := (Id 6) (at level 1). * The \Sigma portion of the states that the variable RR points to a well * formed tree. There are no predicates in the \Pi portion. *) -Definition precondition : absStateBasic := +Definition precondition : absState := (AbsExistsT (TREE(!!RR,v(0),#2,(#0::#1::nil)))). (* @@ -66,15 +71,15 @@ Definition precondition : absStateBasic := * portion. *) -Definition afterInitAssigns : absStateBasic := +Definition afterInitAssigns : absState := (AbsExistsT (AbsExistsT (AbsExistsT (TREE(!!RR,v(0),#2,(#0 :: #1 :: nil)) ** TREE(!!I,v(1),#2,(#0::nil)) ** TREE(!!P,v(2),#2,(#0::nil)) ** (AbsAll (TreeRecords(v(1))) - ([nth(find(v(1),v(3)),#2) inTree v(0)])) ** + ([nth(find(v(2),v(0)),#2) inTree v(1)])) ** (AbsAll (TreeRecords(v(2))) - ([nth(find(v(2),v(3)),#2) inTree v(0)])) ** + ([nth(find(v(3),v(0)),#2) inTree v(1)])) ** ([ (!!T)====#0 \\// (!!T) inTree v(0)]))))). (* @@ -92,60 +97,75 @@ Definition initCode : com := * Most of the proof involves simplifying the clauses after nil is filled * in for the variables I and P and after T is replaced with RR. *) -Theorem initialization : {{precondition}}initCode{{afterInitAssigns,NoResult}}. +Theorem initialization : {{precondition}}initCode{{afterInitAssigns return nil with AbsNone}}. -Proof. simpl. - (* Start by unfolding stuff *) - unfold initCode. unfold afterInitAssigns. unfold precondition. - - intros. eapply strengthenPost. - - (* I ::= A0 *) - eapply compose. pcrunch. (eapply basicAssign;pcrunch). - - (* T ::= !RR *) - eapply compose. pcrunch. (eapply basicAssign;pcrunch). - - (* P ::= A0 *) - (eapply basicAssign;pcrunch). - - (* Prove the state implication (which is not fully automated) *) - crunch. +Proof. + (*unfold initCode. unfold afterInitAssigns. unfold precondition. - eapply basicSimplifyEquiv1 in H. Focus 2. + eapply strengthenPost. + pcrunch. - compute. reflexivity. + Focus 2. intros. inversion H. Focus 2. intros. inversion H. - stateImplication. - - simpl. intros. - eapply ex_intro. eapply ex_intro. eapply ex_intro. clear H. intros. + eapply stripUpdateVarHyp in H. Focus 2. compute. reflexivity. + simplifyHyp H. propagateExistsHyp H. - Transparent basicEval. + stateImplication. clear H. + simpl. intros. - reduceHyp. reduceHyp. reduceHyp. reduceHyp. reduceHyp. reduceHyp. reduceHyp. reduceHyp. - reduceHyp. reduceHyp. reduceHyp. reduceHyp. - reduceHypothesis. Focus 2. - (reduceHypothesis; pcrunch; unfold env_p in *; repeat propagate; simplHyp). - Focus 2. - decomposeTheState. decomposeTheState. - simpl. pcrunch. eapply BStateTree. eapply TreeBase. pcrunch. - pcrunch. pcrunch. - simpl. pcrunch. eapply BStateTree. eapply TreeBase. pcrunch. - pcrunch. pcrunch. - simpl. eapply RSAll. simplifyEval. unfold basicEval. - simpl. reflexivity. intros. inversion H. - simpl. eapply RSAll. simplifyEval. unfold basicEval. - simpl. reflexivity. intros. inversion H. - decomposeBasicState. - - destruct n. rewrite beq_nat_same. simpl. decomposeBasicState. - simpl. unfold Rmember. inversion H17. subst. simpl. rewrite beq_nat_same. decomposeBasicState. - - Existential 1 := NoValue. -Qed. + reduceHyp. reduceHyp. reduceHyp. reduceHyp. reduceHyp. reduceHyp. + reduceHyp. + Transparent basicEval. + simpl in H6. + simpl in H8. + simpl in H10. + Opaque basicEval. + inversion H6; subst; clear H6. inversion H8; subst; clear H8. + inversion H10; subst; clear H10. + reduceHyp. Focus 2. inversion H6; subst; clear H6. elim H8. reflexivity. + reduceHyp. Focus 2. inversion H3; subst; clear H3. elim H4. reflexivity. + reduceHyp. Focus 2. inversion H0; subst; clear H0. elim H1. reflexivity. + + reduceHypothesis. pcrunch. unfold env_p in *. + + erewrite composeEnvPropagate1 in HeqH1. Focus 2. apply H7. simpl in HeqH1. + erewrite composeEnvPropagate1 in HeqH0. Focus 2. apply H9. simpl in HeqH0. + erewrite composeEnvPropagate2 in HeqH0. Focus 2. apply H7. simpl in HeqH0. + erewrite composeEnvPropagate1 in HeqH10. Focus 2. apply H11. simpl in HeqH10. + erewrite composeEnvPropagate2 in HeqH10. Focus 2. apply H9. simpl in HeqH0. + erewrite composeEnvPropagate2 in HeqH10. Focus 2. apply H7. simpl in HeqH10. + erewrite composeEnvPropagate1 in HeqH0. Focus 2. apply H9. simpl in HeqH0. + erewrite composeEnvPropagate2 in HeqH0. Focus 2. apply H7. simpl in HeqH0. + subst. eapply ex_intro. + instantiate (1 := (_::_::_::_::nil)). + + decomposeTheState. + eapply RSEmpty. unfold empty_heap. simpl. reflexivity. + simpl. rewrite HeqH10. eapply BStateTree. pcrunch. eapply TreeBase. + omega. unfold empty_heap. simpl. reflexivity. + eapply SNVCons. eapply SNVNil. + simpl. rewrite HeqH1. eapply BStateTree. pcrunch. eapply TreeBase. + omega. unfold empty_heap. simpl. reflexivity. + eapply SNVCons. eapply SNVNil. + eapply RSAll. simpl. reflexivity. Transparent basicEval. simpl. Opaque basicEval. + reflexivity. intros. inversion H0. + eapply RSAll. simpl. reflexivity. Transparent basicEval. simpl. Opaque basicEval. + reflexivity. intros. inversion H0. + Transparent basicEval. simpl. Opaque basicEval. + + remember (e T). destruct n. simpl. eapply BTStatePredicate. + omega. unfold empty_heap. simpl. reflexivity. + simpl. instantiate (1 := nth 0 b NoValue). erewrite rootIsMember. + eapply BTStatePredicate. omega. unfold empty_heap. simpl. reflexivity. + omega. rewrite HeqH0. + erewrite composeEnvPropagate2 in H15. Focus 2. apply H11. + erewrite composeEnvPropagate2 in H15. Focus 2. apply H9. + erewrite composeEnvPropagate2 in H15. Focus 2. apply H7. simpl in H15. + apply H15.*) + admit. +Admitted. (* @@ -155,24 +175,24 @@ Qed. * This is exactly the same as the state afterInitAssigns except that the * condition T=0 and I=0 have been added. *) -Definition afterWhile : absStateBasic := +Definition afterWhile : absState := (AbsExistsT (AbsExistsT (AbsExistsT (TREE(!!RR,v(0),#2,(#0::#1::nil)) ** TREE(!!I,v(1),#2,(#0::nil)) ** TREE(!!P,v(2),#2,(#0::nil)) ** (AbsAll (TreeRecords(v(2))) - ([nth(find(v(2),v(3)),#2) inTree v(0)])) ** + ([nth(find(v(3),v(0)),#2) inTree v(1)])) ** [(!!T)====#0])))). -Definition loopInv : absStateBasic := +Definition loopInv : absState := (AbsExistsT (AbsExistsT (AbsExistsT (TREE(!!RR,v(0),#2,(#0::#1::nil)) ** TREE(!!I,v(1),#2,(#0::nil)) ** TREE(!!P,AbsQVar 2,#2,(#0::nil)) ** (AbsAll (TreeRecords(v(1))) - ([nth(find(v(1),v(3)),#2) inTree v(0)])) ** + ([nth(find(v(2),v(0)),#2) inTree v(1)])) ** (AbsAll (TreeRecords(v(2))) - ([nth(find(v(2),v(3)),#2) inTree v(0)])) ** + ([nth(find(v(3),v(0)),#2) inTree v(1)])) ** ([(!!T)====#0 \\// (!!T) inTree v(0)]))))). (* * Here is the code for the main loop of the program. @@ -207,365 +227,1118 @@ Definition loop : com := Opaque basicEval. -Theorem loopInvariant : - {{afterInitAssigns}}loop{{afterWhile,NoResult}}. + + +Theorem treeRef1 : forall s n, +(realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) nil s) -> + NatValue n = basicEval I (NatValue (env_p s P) :: NatValue 1 :: nil) -> + heap_p s n <> None. Proof. - (* Break up the while portion of the loop *) - unfold loop. unfold afterWhile. unfold afterInitAssigns. + intros s n H H0. eapply stripUpdateVarHypp in H. vm_compute in H. + simpl in H0. Transparent basicEval. unfold basicEval in H0. + inversion H0; subst; clear H0. + eapply stateAssertionThm in H. simpl in H. crunch. + destruct s. simpl. simpl in H14. + assert (e P + 1 > 0 /\ h (e P + 1) = Some x3). + eapply H14. reflexivity. reflexivity. + inversion H1; subst; clear H1. erewrite H3. intro X. inversion X. +Qed. - (* At this point, our sequent looks something like this: (Compare this to figure 4 in - the paper. - {{AbsExistsT +Theorem treeRef2 : forall s n, (realizeState + (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) nil s) -> NatValue n = basicEval I + (NatValue (env_p s P) :: NatValue 0 :: nil) -> heap_p s n <> None. +Proof. + intros s n H H0. + eapply stripUpdateVarHypp in H. vm_compute in H. + simplifyHyp H. + eapply removeUpdateLocHyp in H. Focus 2. compute. reflexivity. + simpl in H0. Transparent basicEval. unfold basicEval in H0. + inversion H0; subst; clear H0. + eapply stateAssertionThm in H. simpl in H. crunch. + assert (forall x, x+0=x). + intros. induction x9. simpl. reflexivity. simpl. rewrite IHx9. reflexivity. + rewrite H0. + destruct s. simpl. + simpl in H9. + assert ((e P) > 0 /\ h (e P) = Some (e N)). + apply H9. reflexivity. reflexivity. + inversion H1; subst; clear H1. erewrite H7. + intro X. inversion X. +Qed. + + +Theorem deleteExists1 : forall x, (realizeState + (AbsUpdateWithLoc (AbsUpdateWithLoc ([~~ !! (I) ==== # 0] ** + [!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (I) ++++ # 1) Tmp_l !! + (I) ++++ # 0) nil x) -> exists s, (realizeState + (AbsMagicWand (AbsUpdateWithLoc (AbsUpdateWithLoc ([~~ !! (I) ==== # 0] ** + [!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! + (P) !! (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (I) ++++ # 1) Tmp_l !! + (I) ++++ # 0) (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (I) ==== v( 0)]))))) nil s). +Proof. + intros x H0. + Set Printing Depth 200. + propagateExistsHyp H0. propagateExistsHyp H0. + simplifyHyp H0. eapply stripUpdateVarHypp in H0. vm_compute in H0. + simplifyHyp H0. + simplifyHyp H0. propagateExistsHyp H0. + propagateExistsHyp H0. propagateExistsHyp H0. + eapply stripUpdateWithLocHypp in H0. compute in H0. + eapply unfold_rs2 in H0. Focus 2. unfoldHeap (!!I). + simplifyHyp H0. simplifyHyp H0. simplifyHyp H0. + eapply removeUpdateLocHyp in H0. Focus 2. compute. reflexivity. + eapply removeUpdateLocHyp in H0. Focus 2. compute. reflexivity. + eapply stripUpdateWithLocHypp in H0. compute in H0. + eapply stripUpdateWithLocHypp in H0. compute in H0. + simplifyHyp H0. + propagateExistsHyp H0. + eapply existsRealizeState. + intros. + propagateExists. propagateExists. simplify. simplify. + eapply stripUpdateVarp. compute. eapply stripUpdateVarp. compute. + simplify. simplify. propagateExists. + eapply stripUpdateWithLocp. compute. + eapply unfold_rs1. unfoldHeap (!!I). + simplify. + simplify. simplify. simplify. propagateExists. simplify. + eapply removeUpdateLocThm. compute. reflexivity. + eapply removeUpdateLocThm. compute. reflexivity. + eapply stripUpdateWithLocp. compute. + eapply stripUpdateWithLocp. compute. + simplify. propagateExists. + apply H. + eapply magicWandStateExists. + compute. reflexivity. + eapply ex_intro. apply H0. + compute. reflexivity. + compute. reflexivity. + compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsSimp. compute. reflexivity. + eapply propagateInExistsId. reflexivity. + compute. reflexivity. + intros. + compute in H. + eapply stateAssertionThm in H. simpl in H. crunch. + + destruct s. simpl in H. simpl. remember (e I). + destruct n. inversion H. exists n. reflexivity. + + Grab Existential Variables. + apply x. +Qed. + +Opaque mergeStates. + +Theorem mergeTheorem1: +mergeStates + (AbsUpdateVar ([!! (I) ==== # 0] ** + [!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T # 0) + + (AbsUpdateVar + (AbsMagicWand (AbsUpdateWithLoc (AbsUpdateWithLoc ([~~ !! (I) ==== # 0] ** + [!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT (AbsExistsT - (TREE(!!(RR), v(0), #2, #0 :: #1 :: nil) ** - TREE(!!(I), v(1), #2, #0 :: nil) ** - TREE(!!(P), v(2), #2, #0 :: nil) ** - AbsAll TreeRecords(v(1)) ([nth(find(v(1), v(3)), #2) inTree v(0)]) ** - AbsAll TreeRecords(v(2)) ([nth(find(v(2), v(3)), #2) inTree v(0)]) ** - [!!(T) ==== #0 \\// !!(T) inTree v(0)])))}} - WHILE ALnot (!T === A0) - DO N ::= !P; - NEW P, A2; - CStore (!P +++ A1) (!T); - CStore (!P +++ A0) (!N); - CLoad Tmp_l (!T +++ A0); - CLoad Tmp_r (!T +++ A1); - IF ALand (!Tmp_l === A0) (!Tmp_r === A0) - THEN IF !I === A0 THEN T ::= A0 - ELSE CLoad T (!I +++ A1); - CLoad Tmp_l (!I +++ A0); DELETE !I, A2; I ::= !Tmp_l - ELSE IF !Tmp_l === A0 THEN CLoad T (!T +++ A1) - ELSE IF !Tmp_r === A0 THEN CLoad T (!T +++ A0) - ELSE N ::= !I; - NEW I, A2; - CStore (!I +++ A0) (!N); - CLoad Tmp_l (!T +++ A1); - CStore (!I +++ A1) (!Tmp_l); CLoad T (!T +++ A0) LOOP - {{AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! + (P) !! (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (I) ++++ # 1) Tmp_l !!(I) ++++ # 0) (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (I) ==== v( 0)]))))) I !! (Tmp_l)) + + (AbsExistsT (AbsExistsT (AbsExistsT + (TREE(!!RR,v(0),#2,(#0::#1::nil)) ** + TREE(!!I,v(1),#2,(#0::nil)) ** + TREE(!!P,AbsQVar 2,#2,(#0::nil)) ** + (AbsAll (TreeRecords(v(1))) + ([nth(find(v(2),v(0)),#2) inTree v(1)])) ** + (AbsAll (TreeRecords(v(2))) + ([nth(find(v(3),v(0)),#2) inTree v(1)])) ** + ([(!!T)====#0 \\// (!!T) inTree v(0)]))))). +Proof. + Set Printing Depth 200. + eapply stripUpdateVarLeft. compute. reflexivity. + eapply stripUpdateVarRight. compute. reflexivity. + mergePropagateExistsLeft. mergePropagateExistsRight. + eapply removeUpdateLocLeft. compute. reflexivity. + eapply removeUpdateLocLeft. compute. reflexivity. + eapply removeUpdateLocRight. compute. reflexivity. + eapply removeUpdateLocRight. compute. reflexivity. + mergeSimplifyLeft. mergeSimplifyRight. + eapply unfold_merge2. unfoldHeap (v(5)). + mergeSimplifyRight. + eapply stripUpdateWithLocRight. compute. reflexivity. + mergeSimplifyRight. mergePropagateExistsRight. + eapply stripUpdateWithLocRight. compute. reflexivity. + eapply mergeStripVarInsideRight. instantiate (1 := Tmp_l). compute. reflexivity. + eapply stripUpdateWithLocRight. compute. reflexivity. + mergeSimplifyRight. mergePropagateExistsRight. + eapply localizeExistsRightp. compute. + eapply localizeExistsRightp. compute. + eapply localizeExistsRightp. compute. + eapply removeMagicWandRight. compute. reflexivity. + mergeSimplifyRight. mergeSimplifyRight. + eapply mergeStripVarRight. instantiate (1 := Tmp_r). compute. reflexivity. + eapply mergeStripVarLeft. instantiate (1 := Tmp_l). compute. reflexivity. + eapply mergeStripVarLeft. instantiate (1 := Tmp_r). compute. reflexivity. + eapply normalizeRight. instantiate (1 := (I)). compute. + mergeSimplifyRight. mergePropagateExistsRight. + eapply normalizeRight. instantiate (1 := (I)). compute. + + eapply mergeImplies. + + startMerge. + + doMergeStates. + + eapply DMOrPredicates2. compute. + eapply PESComposeRight. eapply PESComposeRight. eapply PESComposeRight. + eapply PESComposeLeft. eapply PESComposeRight. eapply PESComposeLeft. eapply PESR. + eapply PESComposeLeft. eapply PESComposeLeft. eapply PESComposeRight. + eapply PESComposeLeft. eapply PESComposeRight. eapply PESComposeRight. + eapply PESComposeRight. eapply PESComposeRight. eapply PESComposeRight. + eapply PESComposeRight. eapply PESComposeLeft. eapply PESComposeLeft. + eapply PESR. compute. reflexivity. + finishMerge. + + intros. + eapply foldHeapTheorem in H. Focus 2. foldHeap (!!P) (0::nil) 2. + eapply foldAllTheorem in H. Focus 2. foldAll 2. + simplifyHyp H. simplifyHyp H. simplify. + eapply stateImplication. apply H. compute. reflexivity. compute. reflexivity. + prove_implication. compute. reflexivity. compute. reflexivity. simpl. + intros. eapply ex_intro. + eapply emptyRealizeState. simpl. reflexivity. + + intros. compute in H. + eapply stateAssertionThm in H. simpl in H. crunch. + remember (nth 5 bindings NoValue). destruct y. + destruct n. inversion H. exists n. reflexivity. inversion H. inversion H. inversion H. + + Grab Existential Variables. + apply nil. apply nil. +Qed. + + (*eapply FoldAll. compute. reflexivity. compute. reflexivity. solveSPickElement. + solveSPickElement. instantiate (3 := (2)). solveSPickElement. stripFields. + compute. reflexivity. compute. reflexivity. solveSPickElement. compute. reflexivity.*) + (*foldAll 0. + eapply FoldAll. + foldAll 1.*) + (*eapply FoldHeap. instantiate (2 := ((#0)::nil)). stripFields. + compute. reflexivity. (instantiate (2 := (!!P))). + instantiate (2 := 2). pickNCells. pickNHeaps. compute. reflexivity. eapply PNCInductive. solveSPickElement. + eapply PNCInductive0. solveSPickElement. eapply PNCBase. pickNHeaps. + eapply SFCons. eapply SFNil. simpl. reflexivity. + Focus 2. simpl. reflexivity. + Focus 5. simpl.*) + + (*eapply normalizeHyp in H. instantiate (1 := P).*) + +Theorem storeCheck1 : forall s n, realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (I) ==== v( 0)] ** + AbsUpdateVar ([~~ !! (Tmp_r) ==== # 0] ** + [~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( v( 7), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! + (P) !! (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) N v( 1)))))) nil s -> NatValue n = basicEval I + (NatValue (env_p s I) :: NatValue 0 :: nil) -> heap_p s n <> None. +Proof. + Set Printing Depth 1000. + intros s n H H0. + eapply stripUpdateVarHyp in H. Focus 2. compute. reflexivity. + simplifyHyp H. + eapply stateAssertionThm in H. simpl in H. crunch. + + destruct s. Transparent basicEval. simpl. simpl in H9. simpl in H0. + + assert (forall x, x + 0=x). + induction x5. simpl. reflexivity. simpl. rewrite IHx5. reflexivity. + assert ((e I) > 0 /\ h (e I) = Some (e N)). + eapply H9. reflexivity. reflexivity. inversion H3; subst; clear H3. rewrite H2 in H0. + inversion H0; subst; clear H0. + + remember (e I). rewrite H7. + intro X. inversion X. +Qed. + +Set Printing Depth 1000. + +Theorem storeCheck2 : forall s n, + (realizeState + (AbsUpdateWithLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (I) ==== v( 0)] ** + AbsUpdateVar ([~~ !! (Tmp_r) ==== # 0] ** + [~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT (AbsExistsT - (TREE(!!(RR), v(0), #2, #0 :: #1 :: nil) ** - TREE(!!(I), v(1), #2, #0 :: nil) ** - TREE(!!(P), v(2), #2, #0 :: nil) ** - AbsAll TreeRecords(v(2)) ([nth(find(v(2), v(3)), #2) inTree v(0)]) ** - [!!(T) ==== #0]))), NoResult}}*) + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( v( 7), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! + (P) !! (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) N v( 1)))))) !! + (I) ++++ # 0 !! (N)) Tmp_l !! (T) ++++ # 1) nil s +) -> + (NatValue n = basicEval I (NatValue + (env_p s I) :: NatValue 1 :: nil)) -> + heap_p s n <> None. +Proof. + Set Printing Depth 1000. + intros s n H H0. + + eapply stripUpdateVarHyp in H. Focus 2. compute. reflexivity. + simplifyHyp H. + simplifyHyp H. propagateExistsHyp H. propagateExistsHyp H. + propagateExistsHyp H. propagateExistsHyp H. propagateExistsHyp H. + propagateExistsHyp H. + eapply removeUpdateLocHyp in H. Focus 2. simpl. reflexivity. + eapply stripUpdateWithLocHypp in H. compute in H. + eapply stateAssertionThm in H. simpl in H. crunch. + + destruct s. Transparent basicEval. simpl. simpl in H0. simpl in H19. + + assert ((e I) + 1 > 0 /\ h ((e I)+1) = Some x6). + eapply H19. unfold override. simpl. reflexivity. reflexivity. inversion H; subst; clear H. inversion H0; subst; clear H0. + + rewrite H3. intro X. inversion X. +Qed. + +Theorem mergeTheorem2: +mergeStates + (AbsUpdateWithLoc ([!! (Tmp_r) ==== # 0] ** + [~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (T) ++++ # 0) (AbsUpdateWithLoc + (AbsUpdateLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsExistsT + (v( 0) ++++ # 1 |-> v( 2) ** + v( 0) ++++ # 0 |-> v( 1) ** + [!! (I) ==== v( 0)] ** + AbsUpdateVar ([~~ !! (Tmp_r) ==== # 0] ** + [~~ !! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( v( 7), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([ nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([ nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! + (P) !! (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) N v( 1)))))) !! + (I) ++++ # 0 !! (N)) Tmp_l !! (T) ++++ # 1) !! (I) ++++ # 1 !! (Tmp_l)) T !! + (T) ++++ # 0) + + (AbsExistsT (AbsExistsT (AbsExistsT + (TREE(!!RR,v(0),#2,(#0::#1::nil)) ** + TREE(!!I,v(1),#2,(#0::nil)) ** + TREE(!!P,AbsQVar 2,#2,(#0::nil)) ** + (AbsAll (TreeRecords(v(1))) + ([nth(find(v(2),v(0)),#2) inTree v(1)])) ** + (AbsAll (TreeRecords(v(2))) + ([nth(find(v(3),v(0)),#2) inTree v(1)])) ** + ( [(!!T) inTree v(0) \\// (!!T)====#0]))))). +Proof. + eapply mergeImplies. + mergeSimplifyLeft. mergeSimplifyRight. + eapply stripUpdateVarLeft. compute. reflexivity. + eapply stripUpdateVarRight. compute. reflexivity. + mergePropagateExistsLeft. mergePropagateExistsRight. + eapply removeUpdateLocLeft. compute. reflexivity. + eapply removeUpdateLocLeft. compute. reflexivity. + eapply removeUpdateLocRight. compute. reflexivity. + eapply removeUpdateLocRight. compute. reflexivity. + eapply removeUpdateLocRight. compute. reflexivity. + eapply promoteConstraintsRight. compute. + eapply stripUpdateWithLocRight. compute. reflexivity. + eapply mergeStripVarRight. instantiate (1 := Tmp_r). compute. reflexivity. + eapply mergeStripVarLeft. instantiate (1 := Tmp_l). compute. reflexivity. + eapply mergeStripVarLeft. instantiate (1 := Tmp_r). compute. reflexivity. + mergeSimplifyRight. + eapply mergeStripVarInsideRight. instantiate (1 := Tmp_l). compute. reflexivity. + eapply removeUpdateWithLocTraverseRight. compute. + eapply removeUpdateLocRight. compute. reflexivity. + mergeSimplifyRight. mergeSimplifyRight. + eapply stripUpdateVarRight. compute. reflexivity. + eapply mergeSimplifyRight. compute. reflexivity. + eapply removeUpdateWithLocTraverseRight2. compute. + mergeSimplifyRight. + mergeSimplifyRight. + mergePropagateExistsRight. + eapply foldRight. foldHeap (!!P) (0::nil) 2. + eapply foldAllRight. foldAll 2. + eapply foldRight. foldHeap (!!I) (0::nil) 2. + eapply foldAllRight. foldAll 2. + mergeSimplifyRight. + mergeSimplifyRight. + eapply removeUpdateWithLocTraverseLeft2. compute. + mergeSimplifyLeft. + mergePropagateExistsLeft. + eapply foldLeft. foldHeap (!!P) (0::nil) 2. + eapply foldAllLeft. foldAll 2. + mergeSimplifyLeft. + mergePropagateExistsLeft. + + eapply reverseOrLeft. compute. + eapply reverseOrRight. compute. + + startMerge. + + doMergeStates. + + finishMerge. compute. + + intros. + eapply stateImplication. apply H. compute. reflexivity. compute. reflexivity. + prove_implication. compute. reflexivity. compute. reflexivity. simpl. + intros. eapply ex_intro. + eapply emptyRealizeState. compute. reflexivity. + + Grab Existential Variables. + apply nil. apply nil. +Qed. + +Theorem mergeTheorem3: +mergeStates + (AbsUpdateWithLoc ([!! (Tmp_l) ==== # 0] ** + [~~ (!! (Tmp_l) ==== # 0 //\\ !! (Tmp_r) ==== # 0)] ** + AbsUpdateWithLoc (AbsUpdateWithLoc (AbsUpdateLoc (AbsUpdateLoc (AbsExistsT + (AbsExistsT + (AbsExistsT + (AbsUpdateVar (!! (P) ++++ # 1 |-> v( 2) ** + !! (P) |-> v( 1) ** + [!! (P) ==== v( 0)] ** + [# 0 <<<< !! (T)] ** + AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( v( 4), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + + [!! (T) inTree v( 0)])))) N v( 1))))) !! (P) ++++ # 1 !! (T)) !! (P) !! + (N)) Tmp_l !! (T) ++++ # 0) Tmp_r !! (T) ++++ # 1) T !! (T) ++++ # 1) (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0) \\// !! (T) ==== # 0])))) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0) \\// !! (T) ==== # 0])))). +Proof. + eapply mergeImplies. + + mergeSimplifyLeft. + eapply stripUpdateVarLeft. compute. reflexivity. + mergePropagateExistsLeft. + eapply removeUpdateLocLeft. compute. reflexivity. + eapply removeUpdateLocLeft. compute. reflexivity. + eapply mergeStripVarLeft. instantiate (1 := Tmp_l). compute. reflexivity. + eapply mergeStripVarLeft. instantiate (1 := Tmp_r). compute. reflexivity. + eapply removeUpdateWithLocTraverseLeft2. compute. + mergeSimplifyLeft. + mergePropagateExistsLeft. + eapply foldLeft. foldHeap (!!P) (0::nil) 2. + eapply foldAllLeft. foldAll 2. + mergeSimplifyLeft. + mergePropagateExistsLeft. + + eapply reverseOrLeft. compute. + eapply reverseOrRight. compute. + + startMerge. + + doMergeStates. + + finishMerge. compute. + + intros. + eapply stateImplication. apply H. compute. reflexivity. compute. reflexivity. + prove_implication. compute. reflexivity. compute. reflexivity. simpl. + intros. eapply ex_intro. + eapply emptyRealizeState. compute. reflexivity. + + Grab Existential Variables. apply nil. apply nil. +Qed. + +Theorem mergeTheorem4: +mergeStates + (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) ==== # 0 \\// !! (T) inTree v( 0)])))) (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0) \\// !! (T) ==== # 0])))) + (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0) \\// !! (T) ==== # 0])))). +Proof. + eapply mergeImplies. + + startMerge. + doMergeStates. + eapply DMImplyPredicates1. compute. + eapply PESComposeRight. eapply PESComposeRight. eapply PESComposeRight. + eapply PESComposeRight. eapply PESComposeRight. eapply PESR. + compute. reflexivity. + + intros. + simplify. + eapply stateAssertionThm in H0. simpl in H0. crunch. + inversion H5; subst; clear H5. + + eapply RSOrComposeR. eapply RSR. compute. Transparent basicEval. + simpl. rewrite H0. simpl. reflexivity. eapply BTStatePredicate. + intro X. inversion X. + compute. reflexivity. + eapply RSOrComposeL. eapply RSR. simpl. + rewrite H0. simpl. reflexivity. eapply BTStatePredicate. + intro X. inversion X. + compute. reflexivity. + + finishMerge. + + intros. + eapply stateImplication. apply H. compute. reflexivity. compute. reflexivity. + prove_implication. compute. reflexivity. compute. reflexivity. simpl. + intros. eapply ex_intro. + eapply emptyRealizeState. compute. reflexivity. + Grab Existential Variables. apply nil. apply nil. +Qed. + +Theorem implication1: +forall s : state, realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) inTree v( 0) \\// !! (T) ==== # 0])))) nil s -> realizeState (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) ==== # 0 \\// !! (T) inTree v( 0)])))) nil s. +Proof. + intros. + eapply stateImplication. apply H. compute. reflexivity. compute. reflexivity. + prove_implication. compute. reflexivity. compute. reflexivity. simpl. + intros. eapply ex_intro. simplify. + eapply stateAssertionThm in H1. simpl in H1. crunch. + inversion H6; subst; clear H6. + + eapply RSOrComposeR. eapply RSR. Transparent basicEval. + simpl. rewrite H7. simpl. reflexivity. eapply BTStatePredicate. + intro X. inversion X. + compute. reflexivity. + eapply RSOrComposeL. eapply RSR. simpl. + rewrite H7. simpl. reflexivity. eapply BTStatePredicate. + intro X. inversion X. + compute. reflexivity. +Qed. + +Theorem implication2: +forall x : state, realizeState + (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 1)) ([nth( find( v( 2), v( 0)), # 2) inTree v( 1)]) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) ==== # 0 \\// !! (T) inTree v( 0)])))) nil x -> realizeState loopInv nil x. +Proof. + unfold loopInv. + eapply mergeSame. +Qed. + +Theorem implication3: +forall s : state, realizeState + ([~~ (convertToAbsExp (ALnot (! T === A0)))] ** + loopInv) nil s -> realizeState (AbsExistsT + (AbsExistsT + (AbsExistsT + (TREE( !! (RR), v( 0), # 2, # 0 :: # 1 :: nil) ** + TREE( !! (I), v( 1), # 2, # 0 :: nil) ** + TREE( !! (P), v( 2), # 2, # 0 :: nil) ** + AbsAll TreeRecords( v( 2)) ([nth( find( v( 3), v( 0)), # 2) inTree v( 1)]) ** + [!! (T) ==== # 0])))) nil s. +Proof. + unfold loopInv. simpl. intros. + simplifyHyp H. propagateExistsHyp H. propagateExistsHyp H. propagateExistsHyp H. + eapply stateImplication. apply H. compute. reflexivity. compute. reflexivity. + prove_implication. compute. reflexivity. compute. reflexivity. simpl. + intros. eapply ex_intro. eapply emptyRealizeState. compute. reflexivity. + Grab Existential Variables. apply nil. +Qed. + +Theorem loopInvariant : + {{afterInitAssigns}}loop{{afterWhile return nil with AbsNone}}. +Proof. + (* Break up the while portion of the loop *) + unfold loop. unfold afterWhile. unfold afterInitAssigns. (* WHILE ALnot (!T === A0) DO *) eapply strengthenPost. - eapply while with (invariant := loopInv). unfold loopInv. - eapply strengthenPost. + eapply whileThm with (invariant := loopInv). unfold loopInv. + eapply strengthenPost. simpl. (* N ::= !P; *) - eapply compose. pcrunch. (eapply basicAssign; pcrunch). + eapply compose. pcrunch. - (* NEW P,ANum(Size_l); *) - eapply compose. pcrunch. (eapply new_thm; pcrunch). + (* NEW P,ANum(Size_l);*) + eapply compose. pcrunch. simp. simp. simp. - (*assert (simplifyState 0 (nil : list (@Context unit eq_unit (@basicEval unit) (@basicState unit) (@basicAccumulate unit eq_unit))) + (*assert (simplifyState (nil : list (Context)) ((v(0) ++++ #0 |-> v(1) ** - [!!(P) ==== v(0)]):absStateBasic)=AbsEmpty). simpl. + [!!(P) ==== v(0)]):absState)=AbsEmpty). simpl. - assert (buildStateContext ([!!(P)====v(0)]:absStateBasic)=buildStateContext (AbsEmpty)). + assert (buildStateContext ([!!(P)====v(0)]:absState)=buildStateContext (AbsEmpty)). simpl.*) (* CStore ((!P)+++(ANum F_p)) (!T)) *) - eapply compose. pcrunch. store. + eapply compose. eapply store. compute. reflexivity. compute. reflexivity. + intros. eapply treeRef1. apply H. apply H0. + (* CStore ((!P)+++(ANum F_n)) (!N)) *) - eapply compose. pcrunch. store. + eapply compose. eapply store. compute. reflexivity. compute. reflexivity. + eapply treeRef2. (*apply H. apply H0.*) simp. (* CLoad Tmp_l ((!T)+++ANum(F_l)) *) eapply compose. pcrunch. - (*eapply simplifyPre. - eapply SEP. eapply SETSimplifyInExistsT. eapply SETSimplifyInExistsT. eapply SETSimplifyInExistsT. - eapply SETResolvePredicates1. solveSPickElement. solveSPickElement.*) + (* CLoad Tmp_r ((!T) +++ A1) *) + eapply compose. pcrunch. - load_traverse. + (* IF (ALand (!Tmp_l === A0) (!Tmp_r === A0)) *) + eapply if_statement. simpl. - simp. + (* IF (!I === A0) *) + eapply if_statement. simpl. - (* CLoad Tmp_r ((!T)+++ANum(F_r)) *) - eapply compose. pcrunch. load_traverse. + (* T ::= A0 *) + pcrunch. - simp. simp. + (* ELSE *) - (* IF (ALand (!Tmp_l === A0) (!Tmp_r === A0)) *) - eapply if_statement. - (* IF (!I === A0) *) + (* CLoad T (!I)++A1 *) + eapply compose. pcrunch. + + (* CLoad Tmp_l (!I)++A0 *) + eapply compose. pcrunch. + + (* DELETE !I, A2 *) + eapply compose. + Set Printing Depth 200. pcrunch. + eapply deleteExists1. apply H0. + + (* I ::= !Tmp_l *) + pcrunch. + + pcrunch. pcrunch. pcrunch. pcrunch. + + (* FI *) + apply mergeTheorem1. + + (* ELSE *) + + (* (CIf (!Tmp_l === A0) *) + simpl. eapply if_statement. - (* T ::= A0 *) - (eapply basicAssign; pcrunch). + + (* CLoad T (!T +++ A1) *) + simpl. pcrunch. + + (* ELSE *) + + (* CIf (!Tmp_r === A0) *) + simpl. eapply if_statement. + + (* CLoad T (!T +++ A0) *) + simpl. pcrunch. (* ELSE *) - simp. simp. simp. simp. - (* Right before unfolding, we have the following: - {{AbsExistsT - (AbsExistsT - (AbsExistsT - ([!!(Tmp_l) ==== #0] ** - [~~ !!(I) ==== #0] ** - [!!(Tmp_r) ==== #0] ** - [!!(Tmp_r) ==== #0 \\// !!(Tmp_r) inTree v(0)] ** - [nth(nth(find(v(0), !!(T)), #2), #0) ==== !!(Tmp_r)] ** - [nth(nth(find(v(0), !!(T)), #1), #0) ==== #0] ** - [!!(T) inTree v(0)] ** - !!(P) ++++ #0 |-> !!(N) ** - !!(P) ++++ #1 |-> !!(T) ** - [~~ !!(T) ==== #0] ** - TREE(!!(RR), v(0), #2, #0 :: #1 :: nil) ** - TREE(!!(I), v(1), #2, #0 :: nil) ** - TREE(!!(N), v(2), #2, #0 :: nil) ** - AbsAll TreeRecords(v(1)) ([nth(find(v(1), v(3)), #2) inTree v(0)]) ** - AbsAll TreeRecords(v(2)) ([nth(find(v(2), v(3)), #2) inTree v(0)]))))}} - CLoad T (!I +++ A1); CLoad Tmp_l (!I +++ A0); DELETE !I, A2; I ::= !Tmp_l - {{?268448, NoResult}} - *) - - (* Unfold the tree pointed to by !I before proceeding with the first statement *) - eapply unfold_pre. unfoldHeap (@AbsVar unit eq_unit (@basicEval unit) I). - - simp. simp. simp. - - (* Now things look like this (and we can apply our load operator) - {{AbsExistsT - (AbsExistsT - (AbsExistsT - (AbsExistsT - (AbsExistsT - (!!(I) ++++ #1 |-> v(1) ** - !!(I) ++++ #0 |-> nth(v(0), #0) ** - TREE(nth(v(0), #0), - nth(list(!!(I) :: v(0) :: v(1) :: nil), #1), #2, #0 :: nil) ** - [!!(Tmp_l) ==== #0] ** - [~~ !!(I) ==== #0] ** - [!!(Tmp_r) ==== #0] ** - [!!(Tmp_r) ==== #0 \\// !!(Tmp_r) inTree v(2)] ** - [nth(nth(find(v(2), !!(T)), #2), #0) ==== !!(Tmp_r)] ** - [nth(nth(find(v(2), !!(T)), #1), #0) ==== #0] ** - [!!(T) inTree v(2)] ** - !!(P) ++++ #0 |-> !!(N) ** - !!(P) ++++ #1 |-> !!(T) ** - [~~ !!(T) ==== #0] ** - TREE(!!(RR), v(2), #2, #0 :: #1 :: nil) ** - AbsEmpty ** - TREE(!!(N), v(4), #2, #0 :: nil) ** - AbsAll TreeRecords(list(!!(I) :: v(0) :: v(1) :: nil)) - ([nth(find(list(!!(I) :: v(0) :: v(1) :: nil), v(5)), #2) - inTree v(2)]) ** - AbsAll TreeRecords(v(4)) - ([nth(find(v(4), v(5)), #2) inTree v(2)]))))))}} - CLoad T (!I +++ A1); CLoad Tmp_l (!I +++ A0); DELETE !I, A2; I ::= !Tmp_l - {{?268448, NoResult}} - *) - - (* CLoad T ((!I)+++ANum(F_p)) *) - eapply compose. pcrunch. (eapply load; pcrunch). - - (* - {{AbsExistsT - (AbsExistsT - (AbsExistsT - (AbsExistsT - (AbsExistsT - (AbsExistsT - ([!!(T) ==== v(2)] ** - !!(I) ++++ #1 |-> v(2) ** - !!(I) ++++ #0 |-> nth(v(1), #0) ** - TREE(nth(v(1), #0), - nth(list(!!(I) :: v(1) :: v(2) :: nil), #1), #2, - #0 :: nil) ** - [!!(Tmp_l) ==== #0] ** - [~~ !!(I) ==== #0] ** - [!!(Tmp_r) ==== #0] ** - [!!(Tmp_r) ==== #0 \\// !!(Tmp_r) inTree v(3)] ** - [nth(nth(find(v(3), v(0)), #2), #0) ==== !!(Tmp_r)] ** - [nth(nth(find(v(3), v(0)), #1), #0) ==== #0] ** - [v(0) inTree v(3)] ** - !!(P) ++++ #0 |-> !!(N) ** - !!(P) ++++ #1 |-> v(0) ** - [~~ v(0) ==== #0] ** - TREE(!!(RR), v(3), #2, #0 :: #1 :: nil) ** - AbsEmpty ** - TREE(!!(N), v(5), #2, #0 :: nil) ** - AbsAll TreeRecords(list(!!(I) :: v(1) :: v(2) :: nil)) - ([nth(find(list(!!(I) :: v(1) :: v(2) :: nil), v(6)), - #2) inTree v(3)]) ** - AbsAll TreeRecords(v(5)) - ([nth(find(v(5), v(6)), #2) inTree v(3)])))))))}} - CLoad Tmp_l (!I +++ A0); DELETE !I, A2; I ::= !Tmp_l {{?268448, NoResult}} - *) - - (* CLoad Tmp_l ((!I)+++ANum(F_n)) *) - eapply compose. pcrunch. (eapply load; pcrunch). - - (* DELETE !I,ANum(Size_l) *) - eapply compose. pcrunch. (eapply @delete_thm_basic; pcrunch). simpl. reflexivity. - - (* I ::= (!Tmp_l)) *) - (eapply assign; pcrunch). eapply VarAssignedPredicate1. simpl. reflexivity. - solveSPickElement. solveSPickElement. - - (* Merge the left and right branches of the inner if *) - eapply mergeSimplifyLeft. compute. reflexivity. - eapply mergeSimplifyLeft. compute. reflexivity. - eapply mergeSimplifyLeft. compute. reflexivity. - eapply mergeSimplifyLeft. compute. reflexivity. - eapply mergeSimplifyRight. compute. reflexivity. - eapply mergeSimplifyRight. compute. reflexivity. - eapply mergeSimplifyRight. compute. reflexivity. - eapply mergeSimplifyRight. compute. reflexivity. - - startMerge. - - doMergeStates. DMRemoveZeroTree2 ((!!I) : absExpBasic). - DMRemoveZeroAll2. - (* Special case where two predicates need to be or'ed together *) - eapply DMOrPredicates1. instantiate (2 := (!!(T) ==== #0)). solveSPickElement. - instantiate (2 := (!!(T) inTree v(3))). solveSPickElement. pcrunch. - - finishMerge. + (* N ::= !I *) + simpl. eapply compose. pcrunch. + + (* NEW I, A2 *) + eapply compose. pcrunch. + + (* CStore (I ++++ A0) (!N) *) + eapply compose. eapply store. compute. reflexivity. compute. reflexivity. + eapply storeCheck1. (*apply H. apply H0.*) + + (* CLoad Tmp_l (! T +++ A1) *) + eapply compose. pcrunch. + + (* CStore (! I +++ A1) (! Tmp_l) *) + eapply compose. eapply store. compute. reflexivity. compute. reflexivity. + apply storeCheck2. (*apply H. apply H0.*) + + (* (CLoad T (! T +++ A0) *) + pcrunch. + + (* FI *) + Set Printing Depth 2000. + pcrunch. pcrunch. pcrunch. pcrunch. pcrunch. pcrunch. + apply mergeTheorem2. + + (* FI *) + pcrunch. + apply mergeTheorem3. + + (* FI *) + pcrunch. + apply mergeTheorem4. + + pcrunch. pcrunch. pcrunch. pcrunch. pcrunch. pcrunch. + + apply implication1. + + intros. inversion H. + intros. inversion H. + + apply implication2. + apply implication3. + + intros. apply H. + intros. inversion H. + + Grab Existential Variables. + + apply nil. + +Qed. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - (* ELSE *) - simp. simp. simp. - (* IF !Tmp_l === A0 THEN CLoad T (!T +++ ANum F_l) *) - eapply if_statement. simpl. - simp. simp. simp. - (* LOAD T (!T +++ ANum F_r) *) - load_traverse. - (* ELSE *) - (* IF !Tmp_r === A0 THEN *) - eapply if_statement. simpl. - simp. simp. simp. - (* CLoad T (!T +++ ANum F_l) *) - load_traverse. - (* ELSE *) - simp. simp. simp. - (* N ::= !I *) - eapply compose. pcrunch. (eapply basicAssign; pcrunch). - (* NEW I, A2 *) - eapply compose. pcrunch. (eapply new_thm; pcrunch). - simp. simp. simp. simp. - (* CStore (!I +++ A0) (!N) *) - eapply compose. pcrunch. store. - (* CLoad Tmp_l (!T +++ ANum F_r) *) - eapply compose. pcrunch. load_traverse. - (* CStore (!I +++ A1) (!Tmp_l) *) - eapply compose. pcrunch. store. - (* CLoad T (!T +++ ANum F_l) *) - load_traverse. - (* Merge together the ifs, there are a few steps since the simplify is not fully - automated. Simplify is getting completely rewritten after the ITP paper. :-) *) - eapply mergeSimplifyLeft. compute. reflexivity. - eapply mergeSimplifyRight. compute. reflexivity. - (*mergeSimplifyRight. - eapply mergeSimplifyRight. - eapply SEP. - eapply SETSimplifyInExistsT. eapply SETSimplifyInExistsT. eapply SETSimplifyInExistsT. eapply SETSimplifyInExistsT. eapply SETSimplifyInExistsT. - eapply SETFunElim2. instantiate (2 := Tmp_l). solveSPickElement. - simpl. reflexivity. intro X. inversion X. - mergeSimplifyRight. - eapply mergeSimplifyRight. - eapply SEP. - eapply SETSimplifyInExistsT. eapply SETSimplifyInExistsT. eapply SETSimplifyInExistsT. eapply SETSimplifyInExistsT. eapply SETSimplifyInExistsT. - eapply SETResolvePredicates1. - instantiate (3 := (!!(Tmp_l) ==== #0)). solveSPickElement. solveSPickElement. - mergeSimplifyRight.*) - (* Fold the P tree on both the left and right as well as the I tree on the right *) - eapply foldRight. foldHeap (@AbsVar unit eq_unit (@basicEval unit) I) (0::nil) 2. - eapply foldAllRight. foldAll 2. - eapply foldRight. foldHeap (@AbsVar unit eq_unit (@basicEval unit) P) (0::nil) 2. - eapply foldAllRight. foldAll 2. - eapply foldLeft. foldHeap (@AbsVar unit eq_unit (@basicEval unit) P) (0::nil) 2. - eapply foldAllLeft. foldAll 2. - startMerge. - doMergeStates. - finishMerge. - (* Second merge of two ifs, P tree needs to be folded on the left *) - eapply foldLeft. foldHeap (@AbsVar unit eq_unit (@basicEval unit) P) (0::nil) 2. - eapply foldAllLeft. foldAll 2. - eapply mergeSimplifyLeft. compute. reflexivity. - startMerge. doMergeStates. finishMerge. - (* Third and final merge of two ifs, P tree needs to be folded on the left *) - eapply foldLeft. foldHeap (@AbsVar unit eq_unit (@basicEval unit) P) (0::nil) 2. - eapply foldAllLeft. foldAll 2. - eapply mergeSimplifyLeft. compute. reflexivity. - startMerge. doMergeStates. finishMerge. - (* State implication proof *) - crunch. - simplifyHyp H. compute in H. - stateImplication. - compute. - intros. - eapply ex_intro. eapply ex_intro. eapply ex_intro. clear H. intros. - decomposeTheState; eapply RSEmpty; compute; unfold empty_heap; reflexivity. - (* State implication proof *) - unfold loopInv. - crunch. - unfold loopInv. crunch. - simplifyHyp H. simplifyHyp H. simplifyHyp H. compute. unfold loopInv. compute. - stateImplication. - crunch. eapply ex_intro. eapply ex_intro. eapply ex_intro. crunch. - decomposeTheState; eapply RSEmpty; compute; unfold empty_heap; reflexivity. - (* --- and we need to clean up the existential stuff here *) - Existential 1 := NoValue. - Existential 1 := NoValue. - Existential 1 := NoValue. - Existential 1 := NoValue. - Existential 1 := NoValue. - Existential 1 := NoValue. - Existential 1 := nil. - Existential 1 := nil. - Existential 1 := nil. - Existential 1 := nil. - Existential 1 := sbasic. -Qed. diff --git a/PEDANTIC/Unfold.v b/PEDANTIC/Unfold.v index 590f3a2..09da5f7 100644 --- a/PEDANTIC/Unfold.v +++ b/PEDANTIC/Unfold.v @@ -20,33 +20,202 @@ Require Export ImpHeap. Require Export AbsState. Require Export PickElement. Require Export AbsExecute. -Opaque unitEval. -Fixpoint pushExpVar {ev} {eq} {f} (v : nat) (e : @absExp ev eq f) : @absExp ev eq f := +Fixpoint is_condition (s : absState) : bool := + match s with + | AbsStar x y => if is_condition x then is_condition y else false + | AbsOrStar x y => if is_condition x then is_condition y else false + | [x] => true + | _ => false + end. + +Fixpoint getUnfoldRoot (s : absState) : absState := + match s with + | AbsExistsT s => getUnfoldRoot s + | AbsUpdateVar s i v => getUnfoldRoot s + | AbsUpdateWithLoc s i v => getUnfoldRoot s + | AbsUpdateLoc s i v => getUnfoldRoot s + | AbsMagicWand a b => getUnfoldRoot a + | AbsStar x y => if is_condition x then getUnfoldRoot y else if is_condition y + then getUnfoldRoot x else s + | _ => s + end. + +Fixpoint stripVar (v : id) (l : list absState) : list absState := + match l with + | (a::b) => if hasVarState a v + then (stripVar v b) + else a::(stripVar v b) + | nil => nil + end. + +Fixpoint joinStates (l : list absState) (s : absState) := + match l with + | (a::b) => AbsStar a (joinStates b s) + | nil => s + end. + +Fixpoint getUnfoldRootConds (s : absState) (b : list absState) : absState := + match s with + | AbsExistsT s => (getUnfoldRootConds s) (map (addStateVar 0) b) + | AbsUpdateVar s i v => getUnfoldRootConds s (stripVar i b) + | AbsUpdateLoc s i v => getUnfoldRootConds s b + | AbsUpdateWithLoc s i v => getUnfoldRootConds s (stripVar i b) + | AbsMagicWand a d => getUnfoldRootConds a b + | AbsStar x y => if is_condition x then (getUnfoldRootConds y (x::b)) else + if is_condition y then (getUnfoldRootConds x (y::b)) else + joinStates b (AbsStar x y) + | _ => joinStates b s + end. + +Fixpoint updateRootForConds (s : absState) (e : absExp) : absExp := + match s with + | AbsExistsT s => updateRootForConds s (addExpVar 0 e) + | AbsUpdateVar s i v => updateRootForConds s e + | AbsUpdateLoc s i v =>updateRootForConds s e + | AbsUpdateWithLoc s i v => updateRootForConds s e + | AbsMagicWand a b => updateRootForConds a e + | AbsStar ([x]) y => updateRootForConds y e + | AbsStar x ([y]) => updateRootForConds x e + | _ => e + end. + +Fixpoint getUnfoldTrace (s : absState) : list UnfContext := + match s with + | AbsExistsT s => UnfCExistsT::(getUnfoldTrace s) + | AbsUpdateVar s i v => (UnfCUpdateVar i v)::(getUnfoldTrace s) + | AbsUpdateWithLoc s i v => (UnfCUpdateWithLoc i v)::(getUnfoldTrace s) + | AbsUpdateLoc s i v => (UnfCUpdateLoc i v)::(getUnfoldTrace s) + | AbsMagicWand a b => (UnfCMagicWand b)::(getUnfoldTrace a) + | AbsStar x y => if is_condition x then (UnfCStar x)::(getUnfoldTrace y) + else if is_condition y then (UnfCStar y)::(getUnfoldTrace x) + else nil + | _ => nil + end. + +Fixpoint replaceTerm (s : absState) (t : absExp) (r : absExp) := + match t with + | AbsQVar i => Some (replaceStateVar i t s) + | AbsVar v => substVarState s v r + | _ => Some s + end. + +Fixpoint replaceTermExp (e : absExp) (t : absExp) (r : absExp) := + match t with + | AbsQVar i => replaceExpVar i t e + | AbsVar v => substVar e v r + | _ => e + end. + +Fixpoint replaceTermState (e : absState) (t : absExp) (r : absExp) := + match t with + | AbsQVar i => Some (replaceStateVar i t e) + | AbsVar v => substVarState e v r + | _ => Some e + end. + +(*Fixpoint finishState (s : absState) (l : list (UnfContext)) := + match l with + | UnfCExistsT::r => AbsExistsT (finishState s r) + | (UnfCUpdateVar i v)::r => (AbsUpdateVar (finishState s r) i v) + | (UnfCUpdateWithLoc i v)::r => AbsUpdateWithLoc (finishState s r) i v + | (UnfCUpdateLoc i v)::r => AbsUpdateLoc (finishState s r) i v + | (UnfCMagicWand d)::r => AbsMagicWand (finishState s r) d + | (UnfCStar x)::r => AbsStar (finishState s r) ([x]) + | nil => s + end.*) + +Fixpoint rebuildState (s : absState) (l : list UnfContext) (v: absExp) (r: absExp) : option absState := + match l with + (f::rr) => match f with + | UnfCExistsT => match v with + | AbsQVar 0 => Some (AbsExistsT (finishState s rr)) + | AbsQVar (S n) => match rebuildState s rr (AbsQVar n) (removeExpVar 0 r) with + | Some x => Some (AbsExistsT x) + | None => None + end + | x => match rebuildState s rr x (removeExpVar 0 r) with + | Some x => Some (AbsExistsT x) + | None => None + end + end + | UnfCUpdateVar i vv => if beq_absExp (AbsVar i) v then + Some (AbsUpdateVar (finishState s rr) i v) + else + match (rebuildState s rr v r) with + | Some x => Some (AbsUpdateVar x i (replaceTermExp vv v r)) + | None => None + end + | UnfCUpdateWithLoc i vv => if beq_absExp (AbsVar i) v then + Some (AbsUpdateWithLoc (finishState s rr) i v) + else + match (rebuildState s rr v r) with + | Some x => Some (AbsUpdateWithLoc x i (replaceTermExp vv v r)) + | None => None + end + | UnfCUpdateLoc i vv => match rebuildState s rr v r with + | Some x => Some (AbsUpdateLoc x (replaceTermExp i v r) (replaceTermExp vv v r)) + | _ => None + end + | UnfCMagicWand d => match (rebuildState s rr v r),(replaceTerm d v r) with + | Some x,Some y => Some (AbsMagicWand x y) + | _,_ => None + end + | UnfCStar x => match (rebuildState s rr v r),(replaceTermState x v r) with + | Some x,Some y => Some (AbsStar x y) + | _,_ => None + end + end + | nil => Some s + end. + +Fixpoint existsCount (l : list UnfContext) := + match l with + | UnfCExistsT::r => (S (existsCount r)) + | _::r => existsCount r + | nil => 0 + end. + +Fixpoint replaceUnfoldRoot (s : absState) (r : absState) : absState := + match s with + | AbsExistsT s => AbsExistsT (replaceUnfoldRoot s r) + | AbsUpdateVar s i v => AbsUpdateVar (replaceUnfoldRoot s r) i v + | AbsUpdateWithLoc s i v => AbsUpdateWithLoc (replaceUnfoldRoot s r) i v + | AbsUpdateLoc s i v => AbsUpdateLoc (replaceUnfoldRoot s r) i v + | AbsMagicWand a b => AbsMagicWand (replaceUnfoldRoot a r) b + | _ => r + end. + +Fixpoint pushExpVar (start : nat) (v : nat) (e : absExp) : absExp := match e with | AbsConstVal v => AbsConstVal v | AbsVar v => AbsVar v - | AbsQVar vv => AbsQVar (vv+v) - | AbsFun i l => AbsFun i (map (pushExpVar v) l) + | AbsQVar vv => if ble_nat vv start then AbsQVar vv else AbsQVar (vv+v) + | AbsFun i l => AbsFun i (map (pushExpVar start v) l) end. -Fixpoint pushStateVar {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (n : nat) : @absState ev eq f t ac := +Fixpoint pushStateVar (s : absState) (start : nat) (n : nat) : absState := match s with - | AbsStar s1 s2 => (AbsStar (pushStateVar s1 n) (pushStateVar s2 n)) - | AbsOrStar s1 s2 => (AbsOrStar (pushStateVar s1 n) (pushStateVar s2 n)) - | AbsExistsT s => AbsExistsT (pushStateVar s n) - | AbsExists e s => AbsExists (pushExpVar n e) (pushStateVar s n) - | AbsEach e s => AbsEach (pushExpVar n e) (pushStateVar s n) - | AbsAll e s => AbsAll (pushExpVar n e) (pushStateVar s n) + | AbsStar s1 s2 => (AbsStar (pushStateVar s1 start n) (pushStateVar s2 start n)) + | AbsOrStar s1 s2 => (AbsOrStar (pushStateVar s1 start n) (pushStateVar s2 start n)) + | AbsExistsT s => AbsExistsT (pushStateVar s (S start) n) + | AbsExists e s => AbsExists (pushExpVar start n e) (pushStateVar s (S start) n) + | AbsEach e s => AbsEach (pushExpVar start n e) (pushStateVar s (S start) n) + | AbsAll e s => AbsAll (pushExpVar start n e) (pushStateVar s (S start) n) | AbsEmpty => AbsEmpty - | AbsLeaf i l => AbsLeaf i (map (pushExpVar n) l) - | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (pushExpVar n e1) (pushExpVar n e2) (pushExpVar n e3) - | AbsMagicWand s1 s2 => AbsMagicWand (pushStateVar s1 n) (pushStateVar s2 n) - | AbsUpdateVar s i v => AbsUpdateVar (pushStateVar s n) i (pushExpVar n v) - | AbsUpdState s1 s2 s3 => AbsUpdState (pushStateVar s1 n) (pushStateVar s2 n) (pushStateVar s3 n) + | AbsNone => AbsNone + | AbsAny => AbsAny + | AbsLeaf i l => AbsLeaf i (map (pushExpVar start n) l) + | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (pushExpVar start n e1) (pushExpVar start n e2) (pushExpVar start n e3) + | AbsMagicWand s1 s2 => AbsMagicWand (pushStateVar s1 start n) (pushStateVar s2 start n) + | AbsUpdateVar s i v => AbsUpdateVar (pushStateVar s start n) i (pushExpVar start n v) + | AbsUpdateWithLoc s i v => AbsUpdateWithLoc (pushStateVar s start n) i (pushExpVar start n v) + | AbsUpdateLoc s i v => AbsUpdateLoc (pushStateVar s start n) (pushExpVar start n i) (pushExpVar start n v) + | AbsUpdState s1 s2 s3 => AbsUpdState (pushStateVar s1 start n) (pushStateVar s2 start n) (pushStateVar s3 start n) + | AbsClosure s l => AbsClosure s (map (pushExpVar start n) l) end. -Inductive noInstanceExpVar {ev} {eq} {f} : nat -> @absExp ev eq f -> Prop := +Inductive noInstanceExpVar : nat -> absExp -> Prop := | NIAbsConstVal : forall vv v, noInstanceExpVar vv (AbsConstVal v) | NIAbsVar : forall vv v, noInstanceExpVar vv (AbsVar v) | NIAbsQVar : forall v vv, v <> vv -> noInstanceExpVar vv (AbsQVar v) @@ -54,7 +223,7 @@ Inductive noInstanceExpVar {ev} {eq} {f} : nat -> @absExp ev eq f -> Prop := (forall x, In x l -> noInstanceExpVar v x) -> noInstanceExpVar v (AbsFun i l). -Inductive noInstanceStateVar {ev} {eq} {f} {t} {ac} : nat -> @absState ev eq f t ac -> Prop := +Inductive noInstanceStateVar : nat -> absState -> Prop := | NIAbsStar : forall n s1 s2, noInstanceStateVar n s1 -> noInstanceStateVar n s2 -> @@ -88,44 +257,46 @@ Inductive noInstanceStateVar {ev} {eq} {f} {t} {ac} : nat -> @absState ev eq f t noInstanceExpVar n e3 -> noInstanceStateVar n (AbsAccumulate id e1 e2 e3). -Fixpoint build_cells {ev} {eq} {f} {t} {ac} (n : nat) (ff : list nat) (root : @absExp ev eq f) (s : @absState ev eq f t ac) := - match n return @absState ev eq f t ac with +Fixpoint build_cells (n : nat) (ff : list nat) (root : absExp) (s : absState) (o : nat) := + match n return absState with | 0 => s - | S n1 => AbsStar ((root++++#n1) |-> (if mem_nat n1 ff then (nth(v(n1),#0)) else v(n1))) (build_cells n1 ff root s) + | S n1 => AbsStar ((root++++#n1) |-> (if mem_nat n1 ff then (nth(v(n1+o),#0)) else v(n1+o))) (build_cells n1 ff root s o) end. -Fixpoint build_Rs {ev} {eq} {ff} {t} {ac} (f : list nat) (size : nat) (fields : list nat) (h : @absExp ev eq ff) (s : @absState ev eq ff t ac) := +Fixpoint build_Rs (f : list nat) (size : nat) (fields : list nat) (h : absExp) (s : absState) (o : nat) := match f with | nil => s - | (f::r) => AbsStar (AbsLeaf (AbsTreeId) (nth(v(f),#0)::(nth(h,#(f+1)))::(#size)::(map AbsConstVal (map NatValue fields)))) - (build_Rs r size fields h s) + | (f::r) => AbsStar (AbsLeaf (AbsTreeId) (nth(v(f+o),#0)::(nth(h,#(f+1)))::(#size)::(map AbsConstVal (map NatValue fields)))) + (build_Rs r size fields h s o) end. -Fixpoint appendQuants2 {ev} {eq} {ff} {t} {ac} (h : nat) (s : @absState ev eq ff t ac) := +Fixpoint appendQuants2 (h : nat) (s : absState) := match h with | 0 => s | S h1 => AbsExistsT (appendQuants2 h1 s) end. -Fixpoint appendQuants {ev} {eq} {ff} {t} {ac} (n : nat) (h : nat) (s : @absState ev eq ff t ac) := +Fixpoint appendQuants (n : nat) (h : nat) (s : absState) := match n with | 0 => appendQuants2 h s | S n1 => AbsExistsT (appendQuants n1 h s) end. -Inductive constantValues {ev} {eq} {ff} : list (@absExp ev eq ff) -> list nat -> Prop := +Inductive constantValues : list (absExp) -> list nat -> Prop := | ConstantValuesNil : constantValues nil nil | ConstantValuesCons : forall r r' f field, constantValues r r' -> NatValue f = field -> constantValues ((AbsConstVal field)::r) (f::r'). +Ltac solveConstantValues := solve [eapply ConstantValuesNil | (eapply ConstantValuesCons;[solveConstantValues | reflexivity]) ]. + Hint Constructors constantValues. -Fixpoint createVarList {ev} {eq} {ff} start total := +Fixpoint createVarList start total := match total with | 0 => nil - | S(n) => (@AbsQVar ev eq ff start)::(@createVarList ev eq ff (start+1) n) + | S(n) => (AbsQVar start)::(createVarList (start+1) n) end. (* @@ -144,51 +315,209 @@ Fixpoint createVarList {ev} {eq} {ff} start total := (replaceStateVar (h+size) (list(root::(createVarList 0 size))) - (pushStateVar rs' size)))) -> + rs'))) -> state'' = (appendQuants2 size state') -> - unfoldHeap root state state''. -*) -Inductive unfoldHeap {ev} {eq} {ff} {t} {ac} : @absExp ev eq ff -> @absState ev eq ff t ac -> @absState ev eq ff t ac -> Prop := - UnfoldHeap : forall state rs rs' state' state'' fields root s f size h, - rs = getRoot state -> - spickElement rs (AbsLeaf (AbsTreeId) (root::(AbsQVar h)::(AbsConstVal s)::f)) rs' -> + unfoldHeap root state state''.*) + + +Fixpoint replace_term (s : absState) (t : absState) (n : absState) := + match s with + | AbsStar l r => match replace_term l t n with + | Some x => Some (AbsStar x r) + | None => match replace_term r t n with + | Some x => Some (AbsStar l x) + | None => None + end + end + | AbsMagicWand l r => match replace_term l t n with + | Some x => Some (AbsMagicWand x r) + | None => match replace_term r t n with + | Some x => Some (AbsMagicWand l x) + | None => None + end + end + | AbsUpdateVar s i v => match replace_term s t n with + | Some x => Some (AbsUpdateVar x i v) + | None => None + end + | AbsUpdateWithLoc s i v => match replace_term s t n with + | Some x => Some (AbsUpdateWithLoc x i v) + | None => None + end + | x => if beq_absState s t then Some n else None + end. + +Inductive unfoldHeap : absExp -> absState -> absState -> Prop := + UnfoldHeap : forall state rs rs' rt state' state'' fields root s f size h rs'' nn, + rs = getUnfoldRoot state -> + rt = getUnfoldTrace state -> + nn = existsCount rt -> + fpickElement rs (AbsLeaf (AbsTreeId) (root::(AbsQVar h)::(AbsConstVal s)::f)) rs' -> constantValues f fields -> NatValue size = s -> - state' = replaceRoot state - (build_cells size fields root - (build_Rs fields size fields (list(root::(createVarList 0 size))) - (replaceStateVar - (h+size) - (list(root::(createVarList 0 size))) - (pushStateVar rs' size)))) -> + Some rs'' = replace_term (replaceStateVar h (list(root::(createVarList nn size))) rs) (replaceStateVar h (list(root::(createVarList nn size))) (AbsLeaf (AbsTreeId) (root::(AbsQVar h)::(AbsConstVal s)::f))) (build_cells size fields root + (build_Rs fields size fields (list(root::(createVarList nn size))) AbsEmpty nn) nn) -> + Some state' = rebuildState rs'' rt (AbsQVar h) (list(root::(createVarList nn size))) -> state'' = (appendQuants2 size state') -> unfoldHeap root state state''. Ltac unfoldHeap root := eapply UnfoldHeap;[ (compute; reflexivity) | - (instantiate (5 := root); solveSPickElement) | - auto | + (compute; reflexivity) | + (compute; reflexivity) | + (instantiate (5 := root); solveFPickElement) | + solveConstantValues | + (compute; reflexivity) | (compute; reflexivity) | (compute; reflexivity) | (compute; reflexivity) ]. -Theorem unfold_pre {ev} {eq} {ff} {t} {ac} : forall P P' c Q res root, - @unfoldHeap ev eq ff t ac root P P' -> - {{P'}}c{{Q,res}} -> - {{P}}c{{Q,res}}. -Proof. admit. Qed. +Theorem unfold_pre : forall P P' c Q res root Q', + unfoldHeap root P P' -> + {{P'}}c{{Q return res with Q'}} -> + {{P}}c{{Q return res with Q'}}. +Proof. admit. Admitted. + +Theorem unfold_rs1 : forall root P Q bindings s, + unfoldHeap root P Q -> + realizeState Q bindings s -> + realizeState P bindings s. +Proof. admit. Admitted. + +Theorem unfold_rs2 : forall P Q bindings root s, + unfoldHeap root P Q -> + realizeState P bindings s -> + (forall s bindings, realizeState (getUnfoldRootConds P nil) bindings s -> exists v, absEval (env_p s) bindings root=NatValue (S v)) -> + realizeState Q bindings s. +Proof. admit. Admitted. -Theorem unfoldSum {ev} {eq} {ff} {t} {ac} : forall l h e sum bbb lbbb state ee v, +Theorem unfold_merge1 : forall P Q r m root, + unfoldHeap root P Q -> + mergeStates Q r m -> + (forall s bindings, realizeState (getUnfoldRootConds P nil) bindings s -> exists v, absEval (env_p s) bindings root=NatValue (S v)) -> + mergeStates P r m. +Proof. admit. Admitted. + +Theorem unfold_merge2 : forall P Q l m root, + unfoldHeap root P Q -> + mergeStates l Q m -> + (forall s bindings, realizeState (getUnfoldRootConds P nil) bindings s -> exists v, absEval (env_p s) bindings root=NatValue (S v)) -> + mergeStates l P m. +Proof. admit. Admitted. + +Theorem unfoldSum : forall l h e sum bbb lbbb state ee v, lbbb = length bbb -> ee = replaceExpVar lbbb v e -> - @absEval ev eq ff (fst state) bbb (v<<<<(h++++#1))=NatValue 1 -> - ((@realizeState ev eq ff t ac (SUM(range(l,h),e,sum)) bbb state) <-> - (@realizeState ev eq ff t ac (AbsExistsT (AbsExistsT + absEval (fst state) bbb (v<<<<(h++++#1))=NatValue 1 -> + ((realizeState (SUM(range(l,h),e,sum)) bbb state) <-> + (realizeState (AbsExistsT (AbsExistsT (SUM(range(l,v),addExpVar lbbb (addExpVar lbbb e),v(lbbb)) ** (SUM(range(v++++#1,h),addExpVar lbbb (addExpVar lbbb e),v(lbbb+1))) ** [sum====(v(lbbb)++++v(lbbb+1))++++ee]))) bbb state)). -Proof. admit. Qed. +Proof. admit. Admitted. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/UpdateHelper.v b/PEDANTIC/UpdateHelper.v new file mode 100644 index 0000000..a9a798b --- /dev/null +++ b/PEDANTIC/UpdateHelper.v @@ -0,0 +1,61 @@ +(********************************************************************************** + * The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic + * Traversal of Instruction Code) verification framework + * + * Developed by Kenneth Roe + * For more information, check out www.cs.jhu.edu/~roe + * + * UpdateHelper.v + * + **********************************************************************************) + +Require Export SfLib. +Require Export SfLibExtras. +Require Export ImpHeap. +Require Export AbsState. +Require Export AbsExecute. +Require Export AbsStateInstance. +Require Export Simplify. +Require Export Eqdep. +Require Export StateImplication. +Require Export Classical. +Require Export Unfold. +Require Export Fold. +Require Export merge. +Require Export ProgramTactics. + +Theorem realizeStateAbsUpdateWithLoc : forall (as1 : absState) vv valaa bindings s, + realizeState (AbsUpdateWithLoc as1 vv valaa) bindings s -> + exists s1 s valc vald, + (realizeState as1 bindings s1 /\ + (NatValue valc) = absEval (env_p s) bindings valaa /\ + (heap_p s) = (heap_p s1) /\ + (heap_p s) valc = Some vald /\ + (override (env_p s) vv vald)= (env_p s1)). +Proof. + admit. +Admitted. + +Theorem realizeStateAbsUpdateVar : forall (as1 : absState) vv valaa bindings s s1 valc, + realizeState (AbsUpdateVar as1 vv valaa) bindings s -> + (realizeState as1 bindings s1 /\ + (NatValue valc) = absEval (env_p s) bindings valaa /\ + (heap_p s) = (heap_p s1) /\ + (override (env_p s) vv valc)= (env_p s1)). +Proof. + admit. +Admitted. + +Ltac decomposeUpdatesStep := match goal with + | [ H: exists _, _ |- _] => destruct H + | [ H: _ /\ _ |- _] => destruct H + | [ H: realizeState _ _ _ |- _ ] => eapply realizeStateAbsUpdateWithLoc in H + | [ H: realizeState _ _ _ |- _ ] => eapply realizeStateAbsUpdateVar in H + end. + +Ltac decomposeUpdates := repeat decomposeUpdatesStep. + + + + + diff --git a/PEDANTIC/compile b/PEDANTIC/compile index 19486c9..4257308 100755 --- a/PEDANTIC/compile +++ b/PEDANTIC/compile @@ -13,8 +13,13 @@ coqc StateImplication.v coqc Unfold.v coqc merge.v coqc ProgramTactics.v -coqc SatSolverDefs.v -coqc SatSolverMain.v +#coqc SatSolverDefs.v +coqc ClosureHelper.v +coqc UpdateHelper.v +coqc MagicWandExistsHelper.v +coqc StateHypHelper.v +coqc TreeTraversal.v +#coqc SatSolverAux1.v +#coqc SatSolverMain.v date - diff --git a/PEDANTIC/merge.v b/PEDANTIC/merge.v index 7b89cc9..6378103 100644 --- a/PEDANTIC/merge.v +++ b/PEDANTIC/merge.v @@ -22,15 +22,14 @@ Require Export PickElement. Require Export AbsExecute. Require Export Coq.Logic.FunctionalExtensionality. Require Export Fold. -Opaque unitEval. -Fixpoint merge_equiv {ev} {eq} {f} (a : list (@absExp ev eq f)) (t : (@absExp ev eq f)) (b : list (list (@absExp ev eq f))) := +Fixpoint merge_equiv (a : list absExp) (t : absExp) (b : list (list absExp)) := match b with | nil => ((t::a)::nil) | (x::y) => if mem_absExp t x then ((a++x)::y) else x::(merge_equiv a t y) end. -Fixpoint add_equiv {ev} {eq} {f} (equiv : (list (list (@absExp ev eq f)))) (t1 : (@absExp ev eq f)) (t2 : (@absExp ev eq f)) := +Fixpoint add_equiv (equiv : (list (list absExp))) (t1 : absExp) (t2 : absExp) := match equiv with | (a::b) => if mem_absExp t1 a then if mem_absExp t2 a then (a::b) else merge_equiv a t2 b @@ -39,7 +38,7 @@ Fixpoint add_equiv {ev} {eq} {f} (equiv : (list (list (@absExp ev eq f)))) (t1 : | nil => (t1::t2::nil)::nil end. -Inductive build_equivalents {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> (list (list (@absExp ev eq f))) -> Prop := +Inductive build_equivalents : absState -> (list (list absExp)) -> Prop := | BEAdd : forall s s' l r e e', spickElement s ([l====r]) s' -> build_equivalents s' e -> @@ -61,7 +60,7 @@ Fixpoint map_var_right (m : list (nat * nat)) (v : nat) : option nat := | ((a,x)::r) => if beq_nat a v then Some x else map_var r v end. -Fixpoint fold_list {EV} {EQ} {T} (l : list (option (@absExp EV EQ T))) := +Fixpoint fold_list (l : list (option absExp)) := match l with | nil => Some nil | (f::r) => match f,fold_list r with @@ -70,7 +69,7 @@ Fixpoint fold_list {EV} {EQ} {T} (l : list (option (@absExp EV EQ T))) := end end. -Fixpoint mapAbsQVar {EV} {EQ} {T} (m : list (nat * nat)) (e : @absExp EV EQ T) : option (@absExp EV EQ T) := +Fixpoint mapAbsQVar (m : list (nat * nat)) (e : absExp) : option absExp := match e with | AbsConstVal v => Some (AbsConstVal v) | AbsVar vv => Some (AbsVar vv) @@ -81,7 +80,7 @@ Fixpoint mapAbsQVar {EV} {EQ} {T} (m : list (nat * nat)) (e : @absExp EV EQ T) : end end. -Fixpoint mapAbsQVarState {EV} {EQ} {F} {T} {AC} (t1 : nat) (t2 : nat) (m : list (nat * nat)) (s : @absState EV EQ F T AC) : option (@absState EV EQ F T AC) := +Fixpoint mapAbsQVarState (t1 : nat) (t2 : nat) (m : list (nat * nat)) (s : absState) : option absState := match s with | AbsStar s1 s2 => match mapAbsQVarState t1 t2 m s1,mapAbsQVarState t1 t2 m s2 with | Some a, Some b => Some (AbsStar a b) @@ -91,23 +90,25 @@ Fixpoint mapAbsQVarState {EV} {EQ} {F} {T} {AC} (t1 : nat) (t2 : nat) (m : list | Some a, Some b => Some (AbsOrStar a b) | _, _ => None end - | AbsExists e s => match mapAbsQVar m e, mapAbsQVarState (t1+1) (t2+1) ((t1,t2)::m) s with + | AbsExists e s => match mapAbsQVar m e, mapAbsQVarState (t1+1) (t2+1) ((0,0)::(push_pairs m)) s with | Some a, Some b => Some (AbsExists a b) | _, _ => None end - | AbsExistsT s => match mapAbsQVarState (t1+1) (t2+1) ((t1,t2)::m) s with + | AbsExistsT s => match mapAbsQVarState (t1+1) (t2+1) ((0,0)::(push_pairs m)) s with | Some x => Some (AbsExistsT x) | None => None end - | AbsAll e s => match mapAbsQVar m e, mapAbsQVarState (t1+1) (t2+1) ((t1,t2)::m) s with + | AbsAll e s => match mapAbsQVar m e, mapAbsQVarState (t1+1) (t2+1) ((0,0)::(push_pairs m)) s with | Some a, Some b => Some (AbsAll a b) | _, _ => None end - | AbsEach e s => match mapAbsQVar m e, mapAbsQVarState (t1+1) (t2+1) ((t1,t2)::m) s with + | AbsEach e s => match mapAbsQVar m e, mapAbsQVarState (t1+1) (t2+1) ((0,0)::(push_pairs m)) s with | Some a, Some b => Some (AbsEach a b) | _, _ => None end | AbsEmpty => Some AbsEmpty + | AbsNone => Some AbsNone + | AbsAny => Some AbsAny | AbsAccumulate a b c d => match (mapAbsQVar m b),(mapAbsQVar ((t1,t2)::m) c),(mapAbsQVar m d) with | Some bb,Some cc, Some dd => Some (AbsAccumulate a bb cc dd) | _,_,_ => None @@ -124,67 +125,79 @@ Fixpoint mapAbsQVarState {EV} {EQ} {F} {T} {AC} (t1 : nat) (t2 : nat) (m : list | Some a, Some b => Some (AbsUpdateVar a i b) | _, _ => None end + | AbsUpdateLoc s i v => match mapAbsQVarState t1 t2 m s,mapAbsQVar m i,mapAbsQVar m v with + | Some a, Some b, Some c => Some (AbsUpdateLoc a b c) + | _, _, _ => None + end + | AbsUpdateWithLoc s i v => match mapAbsQVarState t1 t2 m s,mapAbsQVar m v with + | Some a, Some b => Some (AbsUpdateWithLoc a i b) + | _, _ => None + end | AbsUpdState s1 s2 s3 => match mapAbsQVarState t1 t2 m s1,mapAbsQVarState t1 t2 m s2,mapAbsQVarState t1 t2 m s3 with | Some a, Some b, Some c => Some (AbsUpdState a b c) | _, _, _ => None end + | AbsClosure s el => match fold_list (map (mapAbsQVar m) el) with + | None => None + | Some l => Some (AbsClosure s l) + end end. -Fixpoint find_list {ev} {eq} {f} t equiv := +Fixpoint find_list t equiv := match equiv with - | (ff::r) => if @mem_absExp ev eq f t ff then ff else find_list t r + | (ff::r) => if mem_absExp t ff then ff else find_list t r | nil => (t::nil) end. -Fixpoint zero_term {ev} {eq} {f} t equiv := +Fixpoint zero_term t equiv := match find_list t equiv with - | l => @mem_absExp ev eq f (#0) l + | l => mem_absExp (#0) l end. -Fixpoint matches_z {ev} {eq} {f} tlist_a equiv := +Fixpoint matches_z tlist_a equiv := match tlist_a with | nil => false - | (ff::r) => @zero_term ev eq f ff equiv + | (ff::r) => zero_term ff equiv end. -Fixpoint matches_zero {ev} {eq} {f} t equiv1 equiv2 := - @matches_z ev eq f (find_list t equiv1) equiv2. +Fixpoint matches_zero t equiv1 equiv2 := + matches_z (find_list t equiv1) equiv2. -Fixpoint null_term {ev} {eq} {f} t equiv := +Fixpoint null_term t equiv := match find_list t equiv with - | l => @mem_absExp ev eq f (AbsConstVal (ListValue nil)) l + | l => mem_absExp (AbsConstVal (ListValue nil)) l end. -Fixpoint matches_n {ev} {eq} {f} tlist_a equiv := +Fixpoint matches_n tlist_a equiv := match tlist_a with | nil => false - | (ff::r) => @null_term ev eq f ff equiv + | (ff::r) => null_term ff equiv end. -Fixpoint matches_null {ev} {eq} {f} t equiv1 equiv2 := - @matches_n ev eq f (find_list t equiv1) equiv2. +Fixpoint matches_null t equiv1 equiv2 := + matches_n (find_list t equiv1) equiv2. -Fixpoint e_exp {ev} {eq} {f} equiv t1 t2 := +Fixpoint e_exp equiv t1 t2 := match equiv with - | (ff::r) => if @mem_absExp ev eq f t1 ff then if @mem_absExp ev eq f t2 ff then true + | (ff::r) => if mem_absExp t1 ff then if mem_absExp t2 ff then true else e_exp r t1 t2 else e_exp r t1 t2 | _ => false end. -Fixpoint equiv_exp {ev} {eq} {f} equiv t1 t2 := - if @beq_absExp ev eq f t1 t2 then +Fixpoint equiv_exp equiv t1 t2 := + if beq_absExp t1 t2 then true else e_exp equiv t1 t2. -Fixpoint build_equals {ev} {eq} {f} {t} {ac} (x : @absExp ev eq f) (l : list (@absExp ev eq f)) : @absState ev eq f t ac := +Fixpoint build_equals (x : absExp) (l : list absExp) : absState := match l with | nil => AbsEmpty | a::b => (([x====a]) ** (build_equals x b)) end. -Fixpoint build_equivs {ev} {eq} {f} {t} {ac} (l : list (list (@absExp ev eq f))) : @absState ev eq f t ac := +Fixpoint build_equivs (l : list (list absExp)) : absState := match l with | nil => AbsEmpty | (a::r)::b => (build_equals a r) ** (build_equivs b) @@ -237,37 +250,43 @@ Fixpoint build_equivs {ev} {eq} {f} {t} {ac} (l : list (list (@absExp ev eq f))) * #9 : list (nat * nat) - output mapping between bound variables * (mappings added by pick2RsNi) *) -Inductive doMergeStates {ev} {eq} {f} {t} {ac} : @absState ev eq f t ac -> - @absState ev eq f t ac -> +Inductive doMergeStates : absState -> + absState -> nat -> nat -> (list (nat * nat)) -> - (list (list (@absExp ev eq f))) -> - (list (list (@absExp ev eq f))) -> - @absState ev eq f t ac -> - @absState ev eq f t ac -> + (list (list absExp)) -> + (list (list absExp)) -> + absState -> + absState -> (list (nat *nat)) -> nat -> Prop := (* Pair two arbitrary predicates by 'oring' them together in the merged state *) | DMOrPredicates1: forall a b a' b' m m' t1 t2 equiv1 equiv2 p1 p2 p2' res tx pairs, spickElement a ([p1]) a' -> spickElement b ([p2]) b' -> - Some p2' = @mapAbsQVar ev eq f m p2 -> - doMergeStates a' b' t1 t2 m equiv1 equiv2 res (([p1]) ** pairs) m' tx -> + Some p2' = mapAbsQVar m p2 -> + doMergeStates a' b' t1 t2 m equiv1 equiv2 res (([p1 \\// p2']) ** pairs) m' tx -> + doMergeStates a b t1 t2 m equiv1 equiv2 (([p1 \\// p2']) ** res) pairs m' tx + (* Pair two arbitrary predicates by 'oring' them together in the merged state *) + | DMOrPredicates2: forall a b a' b' m m' t1 t2 equiv1 equiv2 p1 p2 p2' res tx pairs, + spickElement (a ** (build_equivs equiv1)) ([p1]) a' -> + spickElement (b ** (build_equivs equiv2)) ([p2]) b' -> + Some p2' = mapAbsQVar m p2 -> + doMergeStates a b t1 t2 m equiv1 equiv2 res (([p1 \\// p2']) ** pairs) m' tx -> doMergeStates a b t1 t2 m equiv1 equiv2 (([p1 \\// p2']) ** res) pairs m' tx (* Pair two predicates where the one from the second state implies the one from the first state *) | DMImplyPredicates1: forall a b b' m m' t1 t2 equiv1 equiv2 p2 p2' res tx pairs, (*spickElement a (p1) a' ->*) spickElement b (p2) b' -> - Some p2' = @mapAbsQVarState ev eq f t ac t1 t2 m p2 -> + Some p2' = mapAbsQVarState t1 t2 m p2 -> (forall eee hhh bbb, length bbb=t1 -> realizeState (a ** pairs ** (build_equivs equiv1)) bbb (eee,hhh) -> realizeState p2' bbb (eee,empty_heap)) -> doMergeStates a b' t1 t2 m equiv1 equiv2 res pairs m' tx -> doMergeStates a b t1 t2 m equiv1 equiv2 (p2' ** res) pairs m' tx (* Pair two predicates where the one from the first state implies the one from the second state *) - | DMImplyPredicates2: forall a b a' b' m m' t1 t2 equiv1 equiv2 p1 p2 p2' res tx pairs, - spickElement a ([p1]) a' -> - spickElement b ([p2]) b' -> - Some p2' = @mapAbsQVar ev eq f m p2 -> - (forall e b, @absEval ev eq f e b p1 = NatValue 0 -> @absEval ev eq f e b p2' = NatValue 0) -> - doMergeStates a' b' t1 t2 m equiv1 equiv2 res (([p1]) ** pairs) m' tx -> - doMergeStates a b t1 t2 m equiv1 equiv2 (([p1]) ** res) pairs m' tx + | DMImplyPredicates2: forall a b a' b' m m' t1 t2 equiv1 equiv2 p1 res tx pairs, + spickElement a (p1) a' -> + Some b' = mapAbsQVarState t1 t2 m b -> + (forall eee hhh bbb, length bbb=t1 -> realizeState (b' ** pairs ** (build_equivs equiv1)) bbb (eee,hhh) -> realizeState p1 bbb (eee,empty_heap)) -> + doMergeStates a' b t1 t2 m equiv1 equiv2 res (p1 ** pairs) m' tx -> + doMergeStates a b t1 t2 m equiv1 equiv2 (p1 ** res) pairs m' tx (* Finish the pairing process--can only be done when only predicates are left *) | DMFinish : forall a b t1 t2 equiv1 equiv2 m m' pairs, allPredicates a -> @@ -323,23 +342,23 @@ Ltac DMRemoveZeroAll1 := eapply DMRemoveZeroAll1;[solveSPickElement | (compute;r Ltac DMRemoveZeroAll2 := eapply DMRemoveZeroAll2;[solveSPickElement | (compute;reflexivity) | (compute;reflexivity) | (compute;reflexivity) | idtac]. -Fixpoint addNExistsT {ev} {eq} {f} {t} {ac} n e := +Fixpoint addNExistsT n e := match n with | 0 => e - | (S n1) => addNExistsT n1 (@AbsExistsT ev eq f t ac e) + | (S n1) => addNExistsT n1 (AbsExistsT e) end. (* * This is the theorem that sets up state merging through pairing of the components *) -Theorem MergeStatesTheorem {ev} {eq} {f} {t} {ac} : forall s1 s2 t1 t2 s1' s2' m sm sm' equiv1 equiv2 tx, - (s1',t1) = @remove_top_existentials ev eq f t ac s1 -> - (s2',t2) = @remove_top_existentials ev eq f t ac s2 -> +Theorem MergeStatesTheorem : forall s1 s2 t1 t2 s1' s2' m sm sm' equiv1 equiv2 tx, + (s1',t1) = remove_top_existentials s1 -> + (s2',t2) = remove_top_existentials s2 -> build_equivalents s1' equiv1 -> build_equivalents s2' equiv2 -> doMergeStates s1' s2' t1 t2 nil equiv1 equiv2 sm AbsEmpty m tx -> sm' = addNExistsT t1 sm -> mergeStates s1 s2 sm'. -Proof. admit. Qed. +Proof. admit. Admitted. (* * Tactics for automating the merge process @@ -365,61 +384,443 @@ Ltac finishMerge := eapply DMFinish;[solveAllPredicates | solveAllPredicates]. * ****************************************************************************) -Theorem foldHeapTheorem: forall ev eq f t ac s s' env sr, - realizeState s env sr -> @foldHeap ev eq f t ac s s' -> realizeState s' env sr. -Proof. admit. Qed. +Theorem foldHeapTheorem: forall s s' env sr, + realizeState s env sr -> foldHeap s s' -> realizeState s' env sr. +Proof. admit. Admitted. -Theorem foldLeft : forall ev eq f t ac s s' sx m, - @foldHeap ev eq f t ac s s' -> +Theorem foldLeft : forall s s' sx m, + foldHeap s s' -> mergeStates s' sx m -> mergeStates s sx m. Proof. - unfold mergeStates. intros. inversion H0. subst. clear H0. split. + (*unfold mergeStates. intros. inversion H0. subst. clear H0. split. intros. apply H1. eapply foldHeapTheorem. eapply H0. apply H. - intros. apply H2. apply H0. -Qed. + intros. apply H2. apply H0.*) admit. +Admitted. -Theorem foldRight : forall ev eq f t ac s s' sx m, - @foldHeap ev eq f t ac s s' -> +Theorem foldRight : forall s s' sx m, + foldHeap s s' -> mergeStates sx s' m -> mergeStates sx s m. Proof. - unfold mergeStates. intros. inversion H0. subst. clear H0. split. + (*unfold mergeStates. intros. inversion H0. subst. clear H0. split. intros. eapply H1. apply H0. - intros. eapply H2. eapply foldHeapTheorem. apply H0. apply H. -Qed. + intros. eapply H2. eapply foldHeapTheorem. apply H0. apply H.*) admit. +Admitted. -Theorem foldAllTheorem: forall ev eq f t ac s s' env sr, - realizeState s env sr -> @foldAll ev eq f t ac s s' -> realizeState s' env sr. -Proof. admit. Qed. +Theorem foldAllTheorem: forall s s' env sr, + realizeState s env sr -> foldAll s s' -> realizeState s' env sr. +Proof. admit. Admitted. -Theorem foldAllLeft : forall ev eq f t ac s s' sx m, - @foldAll ev eq f t ac s s' -> +Theorem foldAllLeft : forall s s' sx m, + foldAll s s' -> mergeStates s' sx m -> mergeStates s sx m. Proof. - unfold mergeStates. intros. inversion H0. subst. clear H0. split. + (*unfold mergeStates. intros. inversion H0. subst. clear H0. split. intros. apply H1. eapply foldAllTheorem. eapply H0. apply H. - intros. apply H2. apply H0. -Qed. + intros. apply H2. apply H0.*) admit. +Admitted. -Theorem foldAllRight : forall ev eq f t ac s s' sx m, - @foldAll ev eq f t ac s s' -> +Theorem foldAllRight : forall s s' sx m, + foldAll s s' -> mergeStates sx s' m -> mergeStates sx s m. Proof. - unfold mergeStates. intros. inversion H0. subst. clear H0. split. + (*unfold mergeStates. intros. inversion H0. subst. clear H0. split. intros. eapply H1. apply H0. - intros. eapply H2. eapply foldAllTheorem. apply H0. apply H. -Qed. + intros. eapply H2. eapply foldAllTheorem. apply H0. apply H.*) admit. +Admitted. + +Theorem mergeReturnStatesTrivial1: forall Q r r1, + mergeReturnStates AbsNone Q Q r1 r r. +Proof. + admit. +Admitted. + +Theorem mergeReturnStatesTrivial2: forall Q r r1, + mergeReturnStates Q AbsNone Q r r1 r. +Proof. + admit. +Admitted. + +Theorem mergeStatesTrivial1: forall Q, + mergeStates AbsNone Q Q. +Proof. + admit. +Admitted. + +Theorem mergeStatesTrivial2: forall Q, + mergeStates Q AbsNone Q. +Proof. + admit. +Admitted. + +Fixpoint stripVar (v : id) (s: absState) : option absState := + match s with + | AbsExists e s => if hasVarExp e v then Some AbsEmpty else + match stripVar v s with + | Some s => Some (AbsExists e s) + | None => None + end + | AbsAll e s => if hasVarExp e v then Some AbsEmpty else + match stripVar v s with + | Some s => Some (AbsAll e s) + | None => None + end + | AbsEach e s => if hasVarExp e v then Some AbsEmpty else + match stripVar v s with + | Some s => Some (AbsEach e s) + | None => None + end + | AbsExistsT s => match stripVar v s with + | Some s => Some (AbsExistsT s) + | None => None + end + | AbsStar a b => match stripVar v a,stripVar v b with + | Some a,Some b => Some (AbsStar a b) + | _,_ => None + end + | AbsOrStar a b => match stripVar v a,stripVar v b with + | Some a,Some b => Some (AbsOrStar a b) + | _,_ => None + end + | AbsMagicWand a b => match stripVar v a,stripVar v b with + | Some a,Some b => Some (AbsMagicWand a b) + | _,_ => None + end + | AbsUpdState a b c => match stripVar v a,stripVar v b,stripVar v c with + | Some a,Some b,Some c => Some (AbsUpdState a b c) + | _,_,_ => None + end + | ([x]) => if hasVarExp x v then Some AbsEmpty else Some ([x]) + | AbsAccumulate i a b c => if hasVarExp a v then Some AbsEmpty else + if hasVarExp b v then Some AbsEmpty else + if hasVarExp c v then Some AbsEmpty else + Some (AbsAccumulate i a b c) + | AbsLeaf i vl => if hasVarExpList vl v then None else Some (AbsLeaf i vl) + | AbsEmpty => Some AbsEmpty + | AbsAny => Some AbsAny + | AbsNone => Some AbsNone + | AbsUpdateVar s i e => if beq_id i v then stripVar v s + else if hasVarExp e v then None else + match stripVar v s with + | Some s => Some (AbsUpdateVar s i e) + | None => None + end + | AbsUpdateWithLoc s i e => if beq_id i v then stripVar v s + else if hasVarExp e v then None else + match stripVar v s with + | Some s => Some (AbsUpdateWithLoc s i e) + | None => None + end + | AbsUpdateLoc s i e => if hasVarExp i v then None else + if hasVarExp e v then None else + match stripVar v s with + | Some s => Some (AbsUpdateLoc s i e) + | None => None + end + | AbsClosure s el => if hasVarExpList el v then None else Some (AbsClosure s el) + end. + +Fixpoint stripVarInside (v : id) (s: absState) := + match s with + | AbsExistsT s => AbsExistsT (stripVarInside v s) + | AbsStar a b => AbsStar (stripVarInside v a) (stripVarInside v b) + | AbsMagicWand a b => AbsMagicWand (stripVarInside v a) (stripVarInside v b) + | AbsUpdateVar s i e => if beq_id i v then AbsUpdateVar + (match (stripVar v s) with Some s => s | _ => s end) i e else + AbsUpdateVar (stripVarInside v s) i e + | AbsUpdateWithLoc s i e => if beq_id i v then AbsUpdateWithLoc + (match (stripVar v s) with Some s => s | _ => s end) i e else + AbsUpdateWithLoc (stripVarInside v s) i e + | AbsUpdateLoc s i e => AbsUpdateLoc (stripVarInside v s) i e + | x => x + end. + +Theorem mergeStripVarLeft: forall v left left' right merge, + Some left' = stripVar v left -> + mergeStates left' right merge -> + mergeStates left right merge. +Proof. + admit. +Admitted. + +Theorem mergeStripVarRight: forall v left right' right merge, + Some right' = stripVar v right -> + mergeStates left right' merge -> + mergeStates left right merge. +Proof. + admit. +Admitted. + +Theorem mergeStripVarInsideLeft: forall v left left' right merge, + left' = stripVarInside v left -> + mergeStates left' right merge -> + mergeStates left right merge. +Proof. + admit. +Admitted. + +Theorem mergeStripVarInsideRight: forall v left right' right merge, + right' = stripVarInside v right -> + mergeStates left right' merge -> + mergeStates left right merge. +Proof. + admit. +Admitted. + +Fixpoint findInTree (v : absExp) (s : absState) : option (absExp * absState) := + match s with + | AbsStar a b => match findInTree v a with + | Some (t,a') => Some (t, AbsStar a' b) + | None => match findInTree v b with + | Some (t,b') => Some(t,AbsStar a b') + | None => None + end + end + | [ (vv inTree x)] => if beq_absExp v vv then Some (x,AbsEmpty) else None + | _ => None + end. + +Fixpoint findTheTree (v : absExp) (s : absState) : option absState := + match s with + | AbsStar a b => match findTheTree v a with + | Some a' => Some a' + | None => match findTheTree v b with + | Some b' => Some b' + | None => None + end + end + | (TREE(r,d,n,f)) => if beq_absExp d v then Some (TREE(r,d,n,f)) else None + | _ => None + end. + +Fixpoint propagateLoc2 (v : id) (e : absExp) (s : absState) := + match e with + | ((x)++++(#n)) => match findInTree x s with + | None => None + | Some (tf,s') => match findTheTree tf s' with + | Some (TREE(ee,vv,nn,f)) => if mem_absExp (#n) f then (if hasVarState s' v then + match (substVarState (addStateVar 0 s') v v(0)) with + | Some xx => Some (AbsStar (AbsExistsT (xx ** [v(0) inTree (substVar (addExpVar 0 vv) v v(0))])) (if hasVarExp x v then ([(!!v) inTree vv \\// (!!v)====(#0)]) else ([(!!v) inTree vv \\// (!!v)====(#0)]) ** ([x inTree vv]))) + | _ => None + end + else + Some (AbsStar s' (if hasVarExp x v then ([(!!v) inTree vv \\// (!!v)====(#0)]) else ([(!!v) inTree vv \\// (!!v)====(#0)] ** [x inTree vv])))) else None + | _ => None + end + end + | (x) => match findInTree x s with + | None => None + | Some (tf,s') => match findTheTree tf s' with + | Some (TREE(ee,vv,nn,f)) => if mem_absExp (#0) f then (if hasVarState s' v then + match (substVarState (addStateVar 0 s') v v(0)) with + | Some xx => Some (AbsStar (AbsExistsT (xx ** ([v(0) inTree (substVar (addExpVar 0 vv) v v(0))]))) (if hasVarExp x v then ([(!!v) inTree vv \\// (!!v)====(#0)]) else ([(!!v) inTree vv \\// (!!v)====(#0)]) ** [x inTree vv])) + | _ => None + end + else + Some (AbsStar s' (if hasVarExp x v then ([(!!v) inTree vv \\// (!!v)====(#0)]) else ([(!!v) inTree vv \\// (!!v)====(#0)] ** [x inTree vv])))) else None + | _ => None + end + end + end. + +Fixpoint propagateLoc (v : id) (e : absExp) (s : absState) := + match e with + | ((x)++++(#n)) => match findInTree x s with + | None => None + | Some (tf,s') => match findTheTree tf s' with + | Some (TREE(ee,vv,nn,f)) => if mem_absExp (#n) f then (if hasVarState s' v then None else Some (AbsStar s' (if hasVarExp x v then ([(!!v) inTree vv \\// (!!v)====(#0)]) else ([(!!v) inTree vv \\// (!!v)====(#0)] ** [x inTree vv])))) else None + | _ => None + end + end + | (x) => match findInTree x s with + | None => None + | Some (tf,s') => match findTheTree tf s' with + | Some (TREE(ee,vv,nn,f)) => if mem_absExp (#0) f then (if hasVarState s' v then None else Some (AbsStar s' (if hasVarExp x v then ([(!!v) inTree vv \\// (!!v)====(#0)]) else ([(!!v) inTree vv \\// (!!v)====(#0)] ** [x inTree vv])))) else None + | _ => None + end + end + end. + +Fixpoint removeUpdateWithLocTraverse2 (s : absState) : absState := + match s with + | AbsUpdateWithLoc s i v => match propagateLoc2 i v s with + | Some s' => s' + | None => AbsUpdateWithLoc (removeUpdateWithLocTraverse2 s) i v + end + | AbsStar l r => AbsStar (removeUpdateWithLocTraverse2 l) (removeUpdateWithLocTraverse2 r) + | AbsUpdateLoc s i v => AbsUpdateLoc (removeUpdateWithLocTraverse2 s) i v + | AbsUpdateVar s i v => AbsUpdateVar (removeUpdateWithLocTraverse2 s) i v + | AbsExistsT s => AbsExistsT (removeUpdateWithLocTraverse2 s) + | x => x + end. + +Fixpoint removeUpdateWithLocTraverse (s : absState) : absState := + match s with + | AbsUpdateWithLoc s i v => match propagateLoc i v s with + | Some s' => s' + | None => AbsUpdateWithLoc (removeUpdateWithLocTraverse s) i v + end + | AbsStar l r => AbsStar (removeUpdateWithLocTraverse l) (removeUpdateWithLocTraverse r) + | AbsUpdateLoc s i v => AbsUpdateLoc (removeUpdateWithLocTraverse s) i v + | AbsUpdateVar s i v => AbsUpdateVar (removeUpdateWithLocTraverse s) i v + | AbsExistsT s => AbsExistsT (removeUpdateWithLocTraverse s) + | x => x + end. + +Theorem removeUpdateWithLocTraverseLeft : forall l r m, + mergeStates (removeUpdateWithLocTraverse l) r m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Theorem removeUpdateWithLocTraverseRight : forall l r m, + mergeStates l (removeUpdateWithLocTraverse r) m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Theorem removeUpdateWithLocTraverseLeft2 : forall l r m, + mergeStates (removeUpdateWithLocTraverse2 l) r m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Theorem removeUpdateWithLocTraverseRight2 : forall l r m, + mergeStates l (removeUpdateWithLocTraverse2 r) m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Fixpoint getConstraints (s : absState) : list absState := + match s with + | AbsStar a b => (getConstraints a)++(getConstraints b) + | ([x]) => ([x])::nil + | _ => nil + end. + +Fixpoint stripStates v (l : list absState) := + match l with + | nil => nil + | (a::b) => if hasVarState a v then stripStates v b else a::(stripStates v b) + end. + +Fixpoint mapRelevantConstraints (v : id) (v' : id) (l : list absState) := + match l with + | (f::r) => if hasVarState f v then (replaceStateExp (!!v) (!!v') f)::(mapRelevantConstraints v v' r) else (mapRelevantConstraints v v' r) + | nil => nil + end. + +Fixpoint findPromoteConstraints (v : id) (e : absExp) (s : absState) (l : list absState) : list absState := + match s with + | AbsStar a b => (findPromoteConstraints v e a ((getConstraints b)++l))++(findPromoteConstraints v e b ((getConstraints a)++l)) + | AbsUpdateVar s i vv => stripStates i (findPromoteConstraints v e s (stripStates i l)) + | AbsUpdateWithLoc s i vv => if beq_absExp e vv then (mapRelevantConstraints i v l) else stripStates i (findPromoteConstraints v e s (stripStates i l)) + | _ => nil + end. + +Fixpoint fold_star l root := + match l with + | nil => root + | (a::b) => fold_star b (root ** a) + end. + +Fixpoint promoteConstraints (s : absState) : absState := + match s with + | AbsUpdateWithLoc s i v => fold_star (findPromoteConstraints i v s nil) (AbsUpdateWithLoc (promoteConstraints s) i v) + | AbsStar l r => AbsStar (promoteConstraints l) (promoteConstraints r) + | AbsUpdateLoc s i v => AbsUpdateLoc (promoteConstraints s) i v + | AbsUpdateVar s i v => AbsUpdateVar (promoteConstraints s) i v + | AbsExistsT s => AbsExistsT (promoteConstraints s) + | x => x + end. + +Theorem promoteConstraintsLeft : forall l r m, + mergeStates (promoteConstraints l) r m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Theorem promoteConstraintsRight : forall l r m, + mergeStates l (promoteConstraints r) m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Fixpoint findCell (l : absExp) (s: absState) : option (absState * absState) := + match s with + | AbsStar a b => match findCell l a with + | Some (x,y) => Some(x, AbsStar y b) + | None => match findCell l b with + | Some (x,y) => Some (x, AbsStar a y) + | None => None + end + end + | (x |-> y) => if beq_absExp l x then Some ((x |-> y),AbsEmpty) else None + | _ => None + end. + +Fixpoint reverseOr (s : absState) : absState := + match s with + | AbsStar x y => AbsStar (reverseOr x) (reverseOr y) + | AbsExistsT x => AbsExistsT (reverseOr x) + | AbsOrStar ([x]) ([y]) => [x \\// y] + | x => x + end. + +Theorem reverseOrLeft : forall l r m, + mergeStates (reverseOr l) r m -> + mergeStates l r m. +Proof. + admit. +Admitted. + +Theorem reverseOrRight : forall l r m, + mergeStates l (reverseOr r) m -> + mergeStates l r m. +Proof. + admit. +Admitted. + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PEDANTIC/stateImplication.v b/PEDANTIC/stateImplication.v index 104d030..0e0bd32 100644 --- a/PEDANTIC/stateImplication.v +++ b/PEDANTIC/stateImplication.v @@ -15,15 +15,15 @@ * **********************************************************************************) +Require Import Omega. Require Export SfLib. Require Export ImpHeap. Require Export AbsState. Require Export PickElement. Require Export AbsStateInstance. -Opaque unitEval. (* Glue stuff *) -Fixpoint no_cell_terms {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : bool := +Fixpoint no_cell_terms (s : absState) : bool := match s with | AbsStar a b => if no_cell_terms a then no_cell_terms b else false | AbsExists e s => no_cell_terms s @@ -34,7 +34,7 @@ Fixpoint no_cell_terms {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : boo | _ => true end. -Fixpoint no_r_terms {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : bool := +Fixpoint no_r_terms (s : absState) : bool := match s with | AbsStar a b => if no_r_terms a then no_r_terms b else false | AbsExists e s => no_r_terms s @@ -45,8 +45,8 @@ Fixpoint no_r_terms {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : bool : | _ => true end. -Fixpoint r_term_list {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : list absState := - match s return list (@absState ev eq f t ac) with +Fixpoint r_term_list (s : absState) : list absState := + match s return list (absState) with | AbsStar a b => (r_term_list a)++(r_term_list b) | AbsExists e s => r_term_list s | AbsExistsT s => r_term_list s @@ -56,8 +56,8 @@ Fixpoint r_term_list {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : list | _ => nil end. -Fixpoint predicate_list {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : list absState := - match s return list (@absState ev eq f t ac) with +Fixpoint predicate_list(s : absState) : list absState := + match s return list absState with | AbsStar a b => (predicate_list a)++(predicate_list b) | AbsExists e s => predicate_list s | AbsExistsT s => predicate_list s @@ -67,7 +67,7 @@ Fixpoint predicate_list {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : li | _ => nil end. -Fixpoint strip_front_exists {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) : (absState * nat) := +Fixpoint strip_front_exists (s : absState) : (absState * nat) := match s with | AbsExistsT s => match strip_front_exists s with (st,n) => (st,n+1) @@ -84,28 +84,33 @@ Fixpoint map_over (l : list (nat * nat)) (v : nat) := | ((x1,x2)::r) => if beq_nat x2 v then x1 else map_over r v end. -Fixpoint map_over_exp {ev} {eq} {f} (l : list (nat * nat)) (limit1 : nat) (limit2 : nat) (e : @absExp ev eq f) : absExp := - match e return @absExp ev eq f with +Fixpoint map_over_exp (l : list (nat * nat)) (limit1 : nat) (limit2 : nat) (e : absExp) : absExp := + match e return absExp with | AbsConstVal v => AbsConstVal v | AbsVar v => AbsVar v | AbsQVar v => AbsQVar (if ble_nat limit2 v then (v+limit1)-limit2 else map_over l v) | AbsFun i ll => AbsFun i (map (map_over_exp l limit1 limit2) ll) end. -Fixpoint map_over_state {ev} {eq} {f} {t} {ac} (l : list (nat * nat)) (limit1 : nat) (limit2 : nat) (s : @absState ev eq f t ac) : absState := - match s return @absState ev eq f t ac with +Fixpoint map_over_state (l : list (nat * nat)) (limit1 : nat) (limit2 : nat) (s : absState) : absState := + match s return absState with | AbsStar s1 s2 => (AbsStar (map_over_state l limit1 limit2 s1) (map_over_state l limit1 limit2 s2)) | AbsOrStar s1 s2 => (AbsOrStar (map_over_state l limit1 limit2 s1) (map_over_state l limit1 limit2 s2)) - | AbsExists e s => AbsExists (map_over_exp l limit1 limit2 e) (map_over_state l limit1 limit2 s) - | AbsExistsT s => AbsExistsT (map_over_state l limit1 limit2 s) - | AbsAll e s => AbsAll (map_over_exp l limit1 limit2 e) (map_over_state l limit1 limit2 s) - | AbsEach e s => AbsEach (map_over_exp l limit1 limit2 e) (map_over_state l limit1 limit2 s) + | AbsExists e s => AbsExists (map_over_exp l limit1 limit2 e) (map_over_state (push_pairs l) (S limit1) (S limit2) s) + | AbsExistsT s => AbsExistsT (map_over_state (push_pairs l) (S limit1) (S limit2) s) + | AbsAll e s => AbsAll (map_over_exp l limit1 limit2 e) (map_over_state (push_pairs l) (S limit1) (S limit2) s) + | AbsEach e s => AbsEach (map_over_exp l limit1 limit2 e) (map_over_state (push_pairs l) (S limit1) (S limit2) s) | AbsEmpty => AbsEmpty + | AbsNone => AbsNone + | AbsAny => AbsAny | AbsLeaf i ll => AbsLeaf i (map (map_over_exp l limit1 limit2) ll) - | AbsAccumulate i e1 e2 e3 => AbsAccumulate i (map_over_exp l limit1 limit2 e1) (map_over_exp l limit1 limit2 e2) (map_over_exp l limit1 limit2 e3) + | AbsAccumulate i e1 e2 e3 => AbsAccumulate i (map_over_exp l limit1 limit2 e1) (map_over_exp (push_pairs l) (S limit1) (S limit2) e2) (map_over_exp l limit1 limit2 e3) | AbsMagicWand s1 s2 => AbsMagicWand (map_over_state l limit1 limit2 s1) (map_over_state l limit1 limit2 s2) | AbsUpdateVar s i e => AbsUpdateVar (map_over_state l limit1 limit2 s) i (map_over_exp l limit1 limit2 e) + | AbsUpdateWithLoc s i e => AbsUpdateWithLoc (map_over_state l limit1 limit2 s) i (map_over_exp l limit1 limit2 e) + | AbsUpdateLoc s i e => AbsUpdateLoc (map_over_state l limit1 limit2 s) (map_over_exp l limit1 limit2 i) (map_over_exp l limit1 limit2 e) | AbsUpdState s1 s2 s3 => AbsUpdState (map_over_state l limit1 limit2 s1) (map_over_state l limit1 limit2 s2) (map_over_state l limit1 limit2 s3) + | AbsClosure s ll => AbsClosure s (map (map_over_exp l limit1 limit2) ll) end. Fixpoint mem1 (x : nat) (m : list (nat * nat)) := @@ -120,44 +125,61 @@ Fixpoint mem2 (x : nat) (m : list (nat * nat)) := | ((a,b)::r) => if beq_nat b x then true else mem2 x r end. -Fixpoint complete_mapping1 {ev} {eq} {f} {t} {ac} (x1 : nat) (l1 : nat) (l2 : nat) (s2 : @absState ev eq f t ac) (m : list (nat * nat)) := +Fixpoint complete_mapping1 (x1 : nat) (l1 : nat) (l2 : nat) (s2 : absState) (m : list (nat * nat)) := match x1 with | 0 => (m,l1,l2,s2) | S x1' => if mem1 x1' m then complete_mapping1 x1' l1 l2 s2 m else complete_mapping1 x1' l1 (l2+1) (addStateVar l2 s2) ((x1',l2)::m) end. -Fixpoint complete_mapping2 {ev} {eq} {f} {t} {ac} (x2 : nat) (l1 : nat) (l2 : nat) (s1 : @absState ev eq f t ac) (m : list (nat * nat)) := +Fixpoint complete_mapping2 (x2 : nat) (l1 : nat) (l2 : nat) (s1 : absState) (m : list (nat * nat)) := match x2 with | 0 => (m,l1,l2,s1) | S x2' => if mem2 x2' m then complete_mapping2 x2' l1 l2 s1 m else complete_mapping2 x2' (l1+1) l2 (addStateVar l1 s1) ((l1,x2')::m) end. -Fixpoint complete_mapping {ev} {eq} {f} {t} {ac} (l1 : nat) (l2 : nat) (m : list (nat * nat)) - (s1 : @absState ev eq f t ac) (s2 : @absState ev eq f t ac) := +Fixpoint complete_mapping (l1 : nat) (l2 : nat) (m : list (nat * nat)) + (s1 : absState) (s2 : absState) := match complete_mapping1 l1 l1 l2 s2 m with | (m',l1',l2',s2') => match complete_mapping2 l2' l1' l2' s1 m' with | (m'',l1'',l2'',s1'') => (m'',l1'',l2'',s1'',s2') end end. -Fixpoint prove_state_implication {ev} {eq} {f} {t} {ac} (tl : nat) (s1: @absState ev eq f t ac) (s2 : @absState ev eq f t ac) (e : env) (h : heap) : Prop := +Fixpoint prove_state_implication (tl : nat) (s1: absState) (s2 : absState) (e : env) (h : heap) : Prop := match tl return Prop with | 0 => realizeState s1 nil (e,h) -> realizeState s2 nil (e,empty_heap) | S n => exists x, prove_state_implication n (instantiateState s1 x) (instantiateState s2 x) e h end. +Fixpoint incrementLeft (pairs : list (nat * nat)) := + match pairs with + | ((a,b)::c) => ((S a),b)::(incrementLeft c) + | nil => nil + end. + +Fixpoint incrementRight (pairs : list (nat * nat)) := + match pairs with + | ((a,b)::c) => (a,(S b))::(incrementLeft c) + | nil => nil + end. + (* * This top level definition is responsible for proving implications. It works by first pairing off * identical components and then setting up a proof goal for the remainder. *) -Inductive prove_implication {ev} {eq} {f} {t} {ac} : list (nat * nat) -> @absState ev eq f t ac -> nat -> @absState ev eq f t ac -> nat -> list (nat * nat) -> @absState ev eq f t ac -> Prop := +Inductive prove_implication : list (nat * nat) -> absState -> nat -> absState -> nat -> list (nat * nat) -> absState -> Prop := | CILPairR : forall s1 s2 s1' s2' l1 l2 vars vars' vars'' limit1 limit2 tl, - Some (s1',s2',l1,l2,vars') = pick2RsNiF s1 s2 vars limit1 limit2 (@nil (list (@absExp ev eq f))) (@nil (list (@absExp ev eq f))) -> - (*pick2RsNi s1 s2 vars limit1 limit2 (@nil (list (@absExp ev eq f))) (@nil (list (@absExp ev eq f))) l1 l2 s1' s2' vars' ->*) + Some (s1',s2',l1,l2,vars') = pick2RsNiF s1 s2 vars limit1 limit2 (@nil (list absExp)) (@nil (list absExp)) -> + (*pick2RsNi s1 s2 vars limit1 limit2 (@nil (list absExp)) (@nil (list absExp )) l1 l2 s1' s2' vars' ->*) prove_implication vars' s1' limit1 s2' limit2 vars'' tl -> prove_implication vars s1 limit1 s2 limit2 vars'' tl + | CILPairUpdateWithLoc : forall s1 s2 s1' s2' i1 i2 s1'' s2'' l1 l2 vars vars' vars'' limit1 limit2 tl tl' vars''', + Some (s1',s2',(AbsUpdateWithLoc s1'' i1 l1),(AbsUpdateWithLoc s2'' i2 l2),vars') = pick2UpdateWithLocsNiF s1 s2 vars limit1 limit2 (@nil (list absExp)) (@nil (list absExp)) -> + prove_implication vars' s1' limit1 s2' limit2 vars'' tl -> + prove_implication vars'' s1'' limit1 s2'' limit2 vars''' tl' -> + prove_implication vars s1 limit1 s2 limit2 vars''' (tl ** (AbsUpdateWithLoc tl' i1 l1)) (*| CILPairCell : forall s1 s2 s1' s2' loc1 loc2 val1 val2 vars vars' vars'' limit1 limit2 tl, pick2Cells s1 s2 vars limit1 limit2 nil nil loc1 loc2 val1 val2 s1' s2' vars' -> prove_implication vars' s1' limit1 s2' limit2 vars'' tl -> @@ -166,25 +188,37 @@ Inductive prove_implication {ev} {eq} {f} {t} {ac} : list (nat * nat) -> @absSta prove_implication vars s1 limit1 s2 limit2 vars s1. Ltac prove_implication := (eapply CILPairR;[solve [compute;reflexivity] | prove_implication]) || + (eapply CILPairUpdateWithLoc;[solve [compute;reflexivity] | prove_implication | prove_implication]) || (eapply CILFinish;simpl;reflexivity). +Function stripUpdateWithLocs (s : absState) := + match s with + | AbsUpdateWithLoc ss i v => match substVarState (addStateVar 0 (stripUpdateWithLocs ss)) i v(0) with + | Some x => (AbsExistsT x) + | _ => AbsUpdateWithLoc ss i v + end + | (a ** b) => ((stripUpdateWithLocs a) ** (stripUpdateWithLocs b)) + | AbsUpdateVar ss i v => AbsUpdateVar (stripUpdateWithLocs ss) i v + | x => x + end. + (* * The top level state implication theorem. One state implies another if we * can first pair off many of the identical components and then prove that * the first state implies the remaining components. *) -Theorem stateImplication {ev} {eq} {f} {t} {ac} : forall s state1 (state2 : @absState ev eq f t ac) state1' tl1 tl2 state2' state2'' vars mx l1x l2x state1x state2x state2x', - realizeState state1 nil s -> +Theorem stateImplication : forall s state1 (state2 : absState) state1' tl1 tl2 state2' state2'' vars mx l1x l2x state1x state2x state2x' bb, + realizeState state1 bb s -> (state1',tl1) = remove_top_existentials state1 -> (state2',tl2) = remove_top_existentials state2 -> prove_implication nil state2' tl2 state1' tl1 vars state2'' -> (mx,l2x,l1x,state2x,state1x) = complete_mapping tl2 tl1 vars state2'' state1' -> state2x' = map_over_state mx l1x l2x state2x -> - (forall e h b, length b=l1x-> realizeState state1x b (e,h) -> realizeState state2x' b (e,empty_heap)) -> - realizeState state2 nil s. -Proof. admit. Qed. + (forall e h b, length b=l1x-> (realizeState state1x (bb++b) (e,h)) -> (exists bbb, realizeState (stripUpdateWithLocs state2x') (bb++bbb) (e,empty_heap))) -> + realizeState state2 bb s. +Proof. admit. Admitted. -Definition basicStateImplication := @stateImplication unit eq_unit unitEval basicState basicAccumulate. +Definition basicStateImplication := stateImplication. (* * The tactics below are all useful in applying the stateImplication @@ -260,7 +294,7 @@ Ltac reduceHyp := | [H: absEval (AbsEqual _ _) _ (NatValue 1) |- _] => inversion H; subst; clear H*) | [H: context [instantiateState _ _] |- _ ] => compute in H | [H: exists _, _ |- _] => inversion H; subst; clear H - | [H: context [(match env_p (id->option nat) ?X ?Y ?Z with | Some _ => _ | None => _ end)] |- _] => let xx:=fresh in remember (env_p (id->option nat) X Y Z) as xx; destruct xx; compute in H + | [H: context [(match env_p ?Y ?Z with | Some _ => _ | None => _ end)] |- _] => let xx:=fresh in remember (env_p Y Z) as xx; destruct xx; compute in H (*| [H: context [btnat _] |- _] => unfold btnat in H*) | [H: context [basicEval _ _] |- _] => unfold basicEval in H (*| [H: context [AbsEqualId] |- _] => unfold AbsEqualId in H*) @@ -292,8 +326,8 @@ Ltac simplifyEval := match goal with | [H: Some _ = ?e ?v |- context [?e ?v]] => rewrite <- H;simpl;try simplifyEval | [H: ?e ?v = Some _ |- context [?e ?v]] => rewrite H;simpl;try simplifyEval - | [ |- context [env_p _ _ _ _]] => unfold env_p;simpl;try simplifyEval - | [ |- context [env_p _ _ _]] => unfold env_p;simpl;try simplifyEval + | [ |- context [env_p _ _]] => unfold env_p;simpl;try simplifyEval + | [ |- context [env_p _]] => unfold env_p;simpl;try simplifyEval (*| [ |- context [btnat _]] => unfold btnat*) | [ |- _ = _] => reflexivity (*| [ |- context [AbsEqualId] ] => unfold AbsEqualId; simpl; try simplifyEval @@ -331,7 +365,7 @@ Ltac decomposeTheState := (* * The following definition is used to simplify the reduction of realizeState *) -Fixpoint destructState {ev} {eq} {f} {t} {ac} (a : @absState ev eq f t ac) (bindings : list (@Value ev)) (s : state) : Prop := +Fixpoint destructState (a : absState) (bindings : list (@Value unit)) (s : state) : Prop := match a with | AbsStar as1 as2 => exists h1 h2, (destructState as1 bindings (fst s,h1) /\ @@ -340,39 +374,44 @@ Fixpoint destructState {ev} {eq} {f} {t} {ac} (a : @absState ev eq f t ac) (bind compose_heaps h1 h2=(snd s)) | AbsOrStar as1 as2 => (destructState as1 bindings s) \/ (destructState as2 bindings s) | AbsExists e a => forall e rl, - @absEval ev eq f (env_p _ _ s) bindings e = (ListValue rl) -> + absEval (env_p s) bindings e = (ListValue rl) -> (exists x, In x rl /\ destructState a (bindings++(x::nil)) s) | AbsExistsT a => (exists x, destructState a (bindings++(x::nil)) s) | AbsAccumulate i e1 e2 e3 => forall v3 vl, - absEval (env_p env heap s) bindings e1 = (ListValue vl) -> - absEval (env_p env heap s) bindings e3 = v3 -> - ac i (env_p _ _ s) bindings vl e2 v3 + absEval (env_p s) bindings e1 = (ListValue vl) -> + absEval (env_p s) bindings e3 = v3 -> + basicAccumulate i (env_p s) bindings vl e2 v3 | AbsAll e a => forall rl, - absEval (env_p _ _ s) bindings e = ListValue rl -> + absEval (env_p s) bindings e = ListValue rl -> (forall x, In x rl -> destructState a (bindings++(x::nil)) s) | AbsEach e a => forall v rl states l, - absEval (env_p _ _ s) bindings e = v -> + absEval (env_p s) bindings e = v -> v = ListValue rl -> allFirsts rl l -> allSeconds states l -> (forall x y, In (x,y) l -> destructState a (bindings++(x::nil)) y) -> fold_compose states s | AbsEmpty => (forall x, snd s x=None) - | AbsLeaf i el => t i (map (absEval (env_p _ _ s) bindings) el) (snd s) + | AbsAny => True + | AbsNone => False + | AbsLeaf i el => basicState i (map (absEval (env_p s) bindings) el) (snd s) | AbsMagicWand as1 as2 => exists h1 h2, (destructState as1 bindings (fst s,h1) /\ destructState as2 bindings (fst s,h2) /\ (forall v, ~(h1 v=None) \/ h2 v=None) /\ compose_heaps h2 (snd s)=h1) | AbsUpdateVar ss i e => destructState ss bindings s + | AbsUpdateWithLoc ss i e => destructState ss bindings s + | AbsUpdateLoc ss i e => destructState ss bindings s | AbsUpdState s1 s2 s3 => destructState s1 bindings s + | AbsClosure ss el => destructState ss (map (absEval (env_p s) bindings) el) (empty_env,heap_p s) end. -Theorem realizeDestructThm {ev} {eq} {f} {t} {ac} : forall s b st, - @realizeState ev eq f t ac s b st -> destructState s b st. -Proof. admit. Qed. +Theorem realizeDestructThm : forall s b st, + @realizeState s b st -> destructState s b st. +Proof. admit. Admitted. Ltac removeExistentials := repeat (match goal with @@ -380,37 +419,37 @@ Ltac removeExistentials := | [ H: exists _, _ |- _ ] => (inversion H;subst;clear H) end). -Theorem pickAssertion {ev} {eq} {f} {t} {ac} : forall fs s e P P' bind bind2 x, - @realizeState ev eq f t ac P bind s -> +Theorem pickAssertion : forall fs s e P P' bind bind2 x, + realizeState P bind s -> spickElement P ([e]) P' -> fst s = fs -> x<>0 -> noQVarExp e=true -> absEval fs bind2 e = NatValue x. -Proof. admit. Qed. +Proof. admit. Admitted. -Theorem pickTerm {ev} {eq} {f} {t} {ac} : forall P bind s fs e P', - @realizeState ev eq f t ac P bind s -> +Theorem pickTerm : forall P bind s fs e P', + realizeState P bind s -> spickElement P e P' -> allPredicates e -> fst s = fs -> - @realizeState ev eq f t ac e bind (fs,empty_heap). -Proof. admit. Qed. + realizeState e bind (fs,empty_heap). +Proof. admit. Admitted. Ltac solvePickTerm X := eapply pickTerm;[apply X | solveSPickElement | solveAllPredicates | simpl; reflexivity]. -Theorem pickData {ev} {eq} {f} {t} {ac} : forall P bind s fs e P', - @realizeState ev eq f t ac P bind s -> +Theorem pickData : forall P bind s fs e P', + realizeState P bind s -> spickElement P e P' -> fst s = fs -> - (exists h, @realizeState ev eq f t ac e bind (fs,h)). -Proof. admit. Qed. + (exists h, realizeState e bind (fs,h)). +Proof. admit. Admitted. Ltac solvePickData X := eapply pickData;[apply X | solveSPickElement | simpl; reflexivity]. Theorem concreteComposeEmpty : forall s1 s2 eee, concreteCompose s1 s2 (eee, empty_heap) <-> s1=(eee, empty_heap) /\ s2=(eee, empty_heap). -Proof. admit. Qed. +Proof. admit. Admitted. Theorem nth_replace_same {t} : forall l m n (vv:t) x, m=n -> n < length l -> nth m (replacenth l n vv) x=vv. Proof. @@ -436,7 +475,7 @@ Definition validPredicate {ev} (p : @Value ev) := | _ => false end. -Fixpoint replaceExp {ev} {eq} {f} (e : @absExp ev eq f ) (val:@absExp ev eq f) (rep:@absExp ev eq f) : @absExp ev eq f := +Fixpoint replaceExp (e : absExp ) (val: absExp) (rep:absExp) : absExp := if beq_absExp e val then rep else match e with @@ -446,7 +485,7 @@ Fixpoint replaceExp {ev} {eq} {f} (e : @absExp ev eq f ) (val:@absExp ev eq f) ( | AbsFun i l => AbsFun i (map (fun x => replaceExp x val rep) l) end. -Fixpoint replaceState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (val:@absExp ev eq f) (rep:@absExp ev eq f) : @absState ev eq f t ac := +Fixpoint replaceState (s : absState) (val: absExp) (rep: absExp) : absState := match s with | AbsStar s1 s2 => (AbsStar (replaceState s1 val rep) (replaceState s2 val rep)) | AbsOrStar s1 s2 => (AbsOrStar (replaceState s1 val rep) (replaceState s2 val rep)) @@ -455,11 +494,16 @@ Fixpoint replaceState {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) (val:@ | AbsAll e s => AbsAll (replaceExp e val rep) (replaceState s val rep) | AbsEach e s => AbsEach (replaceExp e val rep) (replaceState s val rep) | AbsEmpty => AbsEmpty + | AbsNone => AbsNone + | AbsAny => AbsAny | AbsLeaf i l => AbsLeaf i (map (fun x => replaceExp x val rep) l) | AbsAccumulate id e1 e2 e3 => AbsAccumulate id (replaceExp e1 val rep) (replaceExp e2 val rep) (replaceExp e3 val rep) | AbsMagicWand s1 s2 => AbsMagicWand (replaceState s1 val rep) (replaceState s2 val rep) | AbsUpdateVar s i v => AbsUpdateVar (replaceState s val rep) i (replaceExp v val rep) - | AbsUpdState s1 s2 s3 => AbsUpdState (replaceState s1 val rep) (replaceState s2 val rep) (replaceState s3 val rep) + | AbsUpdateWithLoc s i v => AbsUpdateWithLoc (replaceState s val rep) i (replaceExp v val rep) + | AbsUpdateLoc s i v => AbsUpdateLoc (replaceState s val rep) (replaceExp i val rep) (replaceExp v val rep) + | AbsUpdState s1 s2 s3 => AbsUpdState (replaceState s1 val rep) (replaceState s2 val rep) (replaceState s3 val rep) + | AbsClosure s l => AbsClosure s (map (fun x => replaceExp x val rep) l) end. Fixpoint pair_check {a} (f : a -> a -> bool) (l1 : list a) (l2 : list a) := @@ -469,7 +513,7 @@ Fixpoint pair_check {a} (f : a -> a -> bool) (l1 : list a) (l2 : list a) := | _,_ => false end. -Fixpoint equivExp {ev} {eq} {f} (e1 : @absExp ev eq f ) (e2 : @absExp ev eq f) (val:@absExp ev eq f) (rep:@absExp ev eq f) : bool := +Fixpoint equivExp (e1 : absExp) (e2 : absExp) (val:absExp) (rep:absExp) : bool := if beq_absExp e1 e2 then true else if beq_absExp e1 val && beq_absExp e2 rep then true else if beq_absExp e1 rep && beq_absExp e2 val then true @@ -486,7 +530,7 @@ Fixpoint equivExp {ev} {eq} {f} (e1 : @absExp ev eq f ) (e2 : @absExp ev eq f) ( | _,_ => false end. -Fixpoint equivState {ev} {eq} {f} {t} {ac} (s1 : @absState ev eq f t ac) (s2 : @absState ev eq f t ac) (val:@absExp ev eq f) (rep:@absExp ev eq f) : bool := +Fixpoint equivState (s1 : absState) (s2 : absState) (val: absExp) (rep: absExp) : bool := match s1,s2 with | AbsStar s1a s1b,AbsStar s2a s2b => (equivState s1a s2a val rep) && (equivState s1b s2b val rep) | AbsOrStar s1a s1b,AbsOrStar s2a s2b => (equivState s1a s2a val rep) && (equivState s1b s2b val rep) @@ -509,7 +553,7 @@ Fixpoint equivState {ev} {eq} {f} {t} {ac} (s1 : @absState ev eq f t ac) (s2 : @ | _, _ => false end. -Fixpoint maxBindingExp {ev} {eq} {f} (e : @absExp ev eq f ) : nat := +Fixpoint maxBindingExp (e : absExp ) : nat := match e with | AbsConstVal x => 0 | AbsVar v => 0 @@ -523,196 +567,196 @@ Fixpoint clipBinding {ev} (b : list (@Value ev)) (n : nat) := | _,_ => nil end. -Theorem expressionSubLR {ev} {eq} {f} {t} {ac} : forall b b' b'' p st e h exp1 exp2 p', - @realizeState ev eq f t ac ([p]) b st -> - validPredicate (@absEval ev eq f e b'' (exp1====exp2))=true -> +Theorem expressionSubLR : forall b b' b'' p st e h exp1 exp2 p', + realizeState ([p]) b st -> + validPredicate (absEval e b'' (exp1====exp2))=true -> b' = clipBinding b (maxBindingExp (exp1====exp2)) -> b' = clipBinding b'' (maxBindingExp (exp1====exp2)) -> st = (e,h) -> p' = replaceExp p exp1 exp2 -> - @realizeState ev eq f t ac ([p']) b st. -Proof. admit. Qed. + realizeState ([p']) b st. +Proof. admit. Admitted. -Theorem expressionNotEqualZero1 {ev} {eq} {f} {t} {ac} : forall b b' b'' p st e h exp p', - @realizeState ev eq f t ac (p) b st -> - false=validPredicate (@absEval ev eq f e b'' (#0====exp)) -> +Theorem expressionNotEqualZero1 : forall b b' b'' p st e h exp p', + realizeState (p) b st -> + false=validPredicate (absEval e b'' (#0====exp)) -> b' = clipBinding b (maxBindingExp (exp)) -> b' = clipBinding b'' (maxBindingExp (exp)) -> st = (e,h) -> p' = replaceState p ((#0) <<<< exp) (#1) -> - @realizeState ev eq f t ac (p') b st. -Proof. admit. Qed. + realizeState (p') b st. +Proof. admit. Admitted. -Theorem expressionNotEqualZero2 {ev} {eq} {f} {t} {ac} : forall b b' b'' p st e h exp p', - @realizeState ev eq f t ac (p) b st -> - false=validPredicate (@absEval ev eq f e b'' (#0====exp)) -> +Theorem expressionNotEqualZero2 : forall b b' b'' p st e h exp p', + realizeState (p) b st -> + false=validPredicate (absEval e b'' (#0====exp)) -> b' = clipBinding b (maxBindingExp (exp)) -> b' = clipBinding b'' (maxBindingExp (exp)) -> st = (e,h) -> p' = replaceState p ((#0) ==== exp) (#0) -> - @realizeState ev eq f t ac (p') b st. -Proof. admit. Qed. + realizeState (p') b st. +Proof. admit. Admitted. -Theorem expressionNotEqualZero3 {ev} {eq} {f} {t} {ac} : forall b b' b'' p st e h exp p', - @realizeState ev eq f t ac (p) b st -> - false=validPredicate (@absEval ev eq f e b'' (#0====exp)) -> +Theorem expressionNotEqualZero3 : forall b b' b'' p st e h exp p', + realizeState (p) b st -> + false=validPredicate (absEval e b'' (#0====exp)) -> b' = clipBinding b (maxBindingExp (exp)) -> b' = clipBinding b'' (maxBindingExp (exp)) -> st = (e,h) -> p' = replaceState p (exp ==== (#0)) (#0) -> - @realizeState ev eq f t ac (p') b st. -Proof. admit. Qed. + realizeState (p') b st. +Proof. admit. Admitted. -Theorem expressionSubRL {ev} {eq} {f} {t} {ac} : forall b b' b'' p st e h exp1 exp2 p', - @realizeState ev eq f t ac (p) b st -> - validPredicate (@absEval ev eq f e b'' (exp1====exp2))=true -> +Theorem expressionSubRL : forall b b' b'' p st e h exp1 exp2 p', + realizeState (p) b st -> + validPredicate (absEval e b'' (exp1====exp2))=true -> b' = clipBinding b (maxBindingExp (exp1====exp2)) -> b' = clipBinding b'' (maxBindingExp (exp1====exp2)) -> st = (e,h) -> p' = replaceState p exp2 exp1 -> - @realizeState ev eq f t ac (p') b st. -Proof. admit. Qed. + realizeState (p') b st. +Proof. admit. Admitted. -Theorem expressionSubRSLR {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp1 exp2 p', - @realizeState ev eq f t ac ([exp1====exp2]) b'' st -> - @realizeState ev eq f t ac (p) b st -> +Theorem expressionSubRSLR : forall b b' b'' p st exp1 exp2 p', + realizeState ([exp1====exp2]) b'' st -> + realizeState (p) b st -> b' = clipBinding b (maxBindingExp (exp1====exp2)) -> b' = clipBinding b'' (maxBindingExp (exp1====exp2)) -> p' = replaceState p exp1 exp2 -> - @realizeState ev eq f t ac (p') b st. -Proof. admit. Qed. + realizeState (p') b st. +Proof. admit. Admitted. -Theorem expressionSubRSNeg {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp1 p', - @realizeState ev eq f t ac ([~~exp1]) b'' st -> - @realizeState ev eq f t ac (p) b st -> +Theorem expressionSubRSNeg : forall b b' b'' p st exp1 p', + realizeState ([~~exp1]) b'' st -> + realizeState (p) b st -> b' = clipBinding b (maxBindingExp (exp1)) -> b' = clipBinding b'' (maxBindingExp (exp1)) -> p' = replaceState p exp1 (#0) -> - @realizeState ev eq f t ac (p') b st. -Proof. admit. Qed. + realizeState (p') b st. +Proof. admit. Admitted. -Theorem expressionSubRSRL {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp1 exp2 p', - @realizeState ev eq f t ac ([exp1====exp2]) b'' st -> - @realizeState ev eq f t ac (p) b st -> +Theorem expressionSubRSRL : forall b b' b'' p st exp1 exp2 p', + realizeState ([exp1====exp2]) b'' st -> + realizeState (p) b st -> b' = clipBinding b (maxBindingExp (exp1====exp2)) -> b' = clipBinding b'' (maxBindingExp (exp1====exp2)) -> p' = replaceState p exp2 exp1 -> - @realizeState ev eq f t ac (p') b st. -Proof. admit. Qed. + realizeState (p') b st. +Proof. admit. Admitted. -Theorem expressionSubEval {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp val p' e, - @NatValue ev val = @absEval ev eq f e b' exp -> - @realizeState ev eq f t ac (p) b'' st -> +Theorem expressionSubEval : forall b b' b'' p st exp val p' e, + @NatValue unit val = absEval e b' exp -> + realizeState (p) b'' st -> e = (fst st) -> p' = replaceState p exp (#val) -> b = clipBinding b' (maxBindingExp exp) -> b = clipBinding b'' (maxBindingExp exp) -> - @realizeState ev eq f t ac (p') b'' st. -Proof. admit. Qed. + realizeState (p') b'' st. +Proof. admit. Admitted. -Theorem expressionSubEvalEval {ev} {eq} {f} {t} {ac} : forall b p st exp1 exp2 p' e, - @absEval ev eq f e b exp2 = @absEval ev eq f e b exp1 -> - @realizeState ev eq f t ac (p) b st -> +Theorem expressionSubEvalEval : forall b p st exp1 exp2 p' e, + absEval e b exp2 = absEval e b exp1 -> + realizeState (p) b st -> e = (fst st) -> p' = replaceState p exp1 exp2 -> - @realizeState ev eq f t ac (p') b st. -Proof. admit. Qed. + realizeState (p') b st. +Proof. admit. Admitted. -Theorem expressionSubGRSLR {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp1 exp2 p', - @realizeState ev eq f t ac ([exp1====exp2]) b'' st -> +Theorem expressionSubGRSLR : forall b b' b'' p st exp1 exp2 p', + realizeState ([exp1====exp2]) b'' st -> b' = clipBinding b (maxBindingExp (exp1====exp2)) -> b' = clipBinding b'' (maxBindingExp (exp1====exp2)) -> p' = replaceExp p exp1 exp2 -> - @realizeState ev eq f t ac ([p']) b st -> - @realizeState ev eq f t ac ([p]) b st. -Proof. admit. Qed. + realizeState ([p']) b st -> + realizeState ([p]) b st. +Proof. admit. Admitted. -Theorem expressionSubGRSRL {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp1 exp2 p', - @realizeState ev eq f t ac ([exp1====exp2]) b'' st -> +Theorem expressionSubGRSRL : forall b b' b'' p st exp1 exp2 p', + realizeState ([exp1====exp2]) b'' st -> b' = clipBinding b (maxBindingExp (exp1====exp2)) -> b' = clipBinding b'' (maxBindingExp (exp1====exp2)) -> p' = replaceExp p exp2 exp1 -> - @realizeState ev eq f t ac ([p']) b st -> - @realizeState ev eq f t ac ([p]) b st. -Proof. admit. Qed. + realizeState ([p']) b st -> + realizeState ([p]) b st. +Proof. admit. Admitted. -Theorem expressionSubGLR {ev} {eq} {f} {t} {ac} : forall b b' e b'' p st exp1 exp2 p', - validPredicate (@absEval ev eq f e b'' (exp1====exp2))=true -> +Theorem expressionSubGLR : forall b b' e b'' p st exp1 exp2 p', + validPredicate (absEval e b'' (exp1====exp2))=true -> e = (fst st) -> b' = clipBinding b (maxBindingExp (exp1====exp2)) -> b' = clipBinding b'' (maxBindingExp (exp1====exp2)) -> p' = replaceExp p exp1 exp2 -> - @realizeState ev eq f t ac ([p']) b st -> - @realizeState ev eq f t ac ([p]) b st. -Proof. admit. Qed. + realizeState ([p']) b st -> + realizeState ([p]) b st. +Proof. admit. Admitted. -Theorem expressionSubGRL {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp1 exp2 p' e, - validPredicate (@absEval ev eq f e b'' (exp1====exp2))=true -> +Theorem expressionSubGRL : forall b b' b'' p st exp1 exp2 p' e, + validPredicate (absEval e b'' (exp1====exp2))=true -> e = (fst st) -> b' = clipBinding b (maxBindingExp (exp1====exp2)) -> b' = clipBinding b'' (maxBindingExp (exp1====exp2)) -> p' = replaceState p exp2 exp1 -> - @realizeState ev eq f t ac (p') b st -> - @realizeState ev eq f t ac (p) b st. -Proof. admit. Qed. + realizeState (p') b st -> + realizeState (p) b st. +Proof. admit. Admitted. -Theorem expressionSubGRSNeg {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp p' e, - @realizeState ev eq f t ac ([exp]) b'' st -> +Theorem expressionSubGRSNeg : forall b b' b'' p st exp p' e, + realizeState ([exp]) b'' st -> b' = clipBinding b (maxBindingExp (exp)) -> b' = clipBinding b'' (maxBindingExp (exp)) -> p' = replaceExp p (~~exp) (#0) -> e = (fst st) -> - @absEval ev eq f e b p= - @absEval ev eq f e b p'. -Proof. admit. Qed. + absEval e b p= + absEval e b p'. +Proof. admit. Admitted. -Theorem expressionSubGRSOr1 {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp p' e x y, - @realizeState ev eq f t ac ([exp]) b'' st -> +Theorem expressionSubGRSOr1 : forall b b' b'' p st exp p' e x y, + realizeState ([exp]) b'' st -> b' = clipBinding b (maxBindingExp (exp)) -> b' = clipBinding b'' (maxBindingExp (exp)) -> p' = replaceState p ((exp\\//x)//\\y) (y) -> e = (fst st) -> - @realizeState ev eq f t ac (p') b st -> - @realizeState ev eq f t ac (p) b st. -Proof. admit. Qed. + realizeState (p') b st -> + realizeState (p) b st. +Proof. admit. Admitted. -Theorem expressionSubGRSOr2 {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp p' e x y, - @realizeState ev eq f t ac ([exp]) b'' st -> +Theorem expressionSubGRSOr2 : forall b b' b'' p st exp p' e x y, + realizeState ([exp]) b'' st -> b' = clipBinding b (maxBindingExp (exp)) -> b' = clipBinding b'' (maxBindingExp (exp)) -> p' = replaceState p ((x\\//exp)//\\y) (y) -> e = (fst st) -> - @realizeState ev eq f t ac (p') b st -> - @realizeState ev eq f t ac (p) b st. -Proof. admit. Qed. + realizeState (p') b st -> + realizeState (p) b st. +Proof. admit. Admitted. -Theorem expressionSubGRSNeg1 {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp p' e, - @realizeState ev eq f t ac ([exp]) b'' st -> +Theorem expressionSubGRSNeg1 : forall b b' b'' p st exp p' e, + realizeState ([exp]) b'' st -> b' = clipBinding b (maxBindingExp (exp)) -> b' = clipBinding b'' (maxBindingExp (exp)) -> p' = replaceState p (~~exp) (#0) -> e = (fst st) -> - @realizeState ev eq f t ac (p') b st -> - @realizeState ev eq f t ac (p) b st. -Proof. admit. Qed. + realizeState (p') b st -> + realizeState (p) b st. +Proof. admit. Admitted. -Theorem expressionSubRSVP {ev} {eq} {f} {t} {ac} : forall b b' b'' p st exp1 exp2 p' eee, - @realizeState ev eq f t ac ([exp1====exp2]) b st -> +Theorem expressionSubRSVP : forall b b' b'' p st exp1 exp2 p' eee, + realizeState ([exp1====exp2]) b st -> b' = clipBinding b (maxBindingExp (exp1====exp2)) -> b' = clipBinding b'' (maxBindingExp (exp1====exp2)) -> p' = replaceExp p exp1 exp2 -> eee = fst st -> - validPredicate (@absEval ev eq f eee b'' p)=validPredicate (@absEval ev eq f eee b'' p'). -Proof. admit. Qed. + validPredicate (absEval eee b'' p)=validPredicate (absEval eee b'' p'). +Proof. admit. Admitted. -Theorem removeQuantVar {ev} {eq} {f} {t} {ac} : forall n b e h var exp1 exp2, - @realizeState ev eq f t ac exp2 b (e,h) -> +Theorem removeQuantVar : forall n b e h var exp1 exp2, + realizeState exp2 b (e,h) -> nth n b NoValue = NatValue (e var) -> equivState exp1 exp2 (!!var) (v(n)) = true -> - @realizeState ev eq f t ac exp1 b (e,h). -Proof. admit. Qed. + realizeState exp1 b (e,h). +Proof. admit. Admitted. -Fixpoint removeReplaceExp {ev} {eq} {f} (loc1 : @absExp ev eq f) (loc2 : @absExp ev eq f) (exp : @absExp ev eq f) := +Fixpoint removeReplaceExp (loc1 : absExp) (loc2 : absExp) (exp : absExp) := match exp with | AbsFun (AbsNthId) (p::q::nil) => match p,q with @@ -728,7 +772,7 @@ Fixpoint removeReplaceExp {ev} {eq} {f} (loc1 : @absExp ev eq f) (loc2 : @absExp | x => x end. -Fixpoint removeReplaceState {ev} {eq} {f} {t} {ac} (loc1 : @absExp ev eq f) (loc2 : @absExp ev eq f) (s:@absState ev eq f t ac) : @absState ev eq f t ac := +Fixpoint removeReplaceState (loc1 : absExp) (loc2 : absExp) (s:absState) : absState := match s with | AbsStar s1 s2 => (AbsStar (removeReplaceState loc1 loc2 s1) (removeReplaceState loc1 loc2 s2)) | AbsOrStar s1 s2 => (AbsOrStar (removeReplaceState loc1 loc2 s1) (removeReplaceState loc1 loc2 s2)) @@ -737,24 +781,29 @@ Fixpoint removeReplaceState {ev} {eq} {f} {t} {ac} (loc1 : @absExp ev eq f) (loc | AbsAll e s => AbsAll (removeReplaceExp loc1 loc2 e) (removeReplaceState loc1 loc2 s) | AbsEach e s => AbsEach (removeReplaceExp loc1 loc2 e) (removeReplaceState loc1 loc2 s) | AbsEmpty => AbsEmpty + | AbsNone => AbsNone + | AbsAny => AbsAny | AbsLeaf i l => AbsLeaf i (map (removeReplaceExp loc1 loc2) l) | AbsAccumulate i e1 e2 e3 => AbsAccumulate i (removeReplaceExp loc1 loc2 e1) (removeReplaceExp loc1 loc2 e2) (removeReplaceExp loc1 loc2 e3) | AbsMagicWand s1 s2 => AbsMagicWand (removeReplaceState loc1 loc2 s1) (removeReplaceState loc1 loc2 s2) | AbsUpdateVar s i v => AbsUpdateVar (removeReplaceState loc1 loc2 s) i (removeReplaceExp loc1 loc2 v) + | AbsUpdateWithLoc s i v => AbsUpdateWithLoc (removeReplaceState loc1 loc2 s) i (removeReplaceExp loc1 loc2 v) + | AbsUpdateLoc s i v => AbsUpdateLoc (removeReplaceState loc1 loc2 s) (removeReplaceExp loc1 loc2 i) (removeReplaceExp loc1 loc2 v) | AbsUpdState s1 s2 s3 => AbsUpdState (removeReplaceState loc1 loc2 s1) (removeReplaceState loc1 loc2 s2) (removeReplaceState loc1 loc2 s3) + | AbsClosure s l => AbsClosure s (map (removeReplaceExp loc1 loc2) l) end. -Theorem removeReplace {ev} {eq} {f} {t} {ac} : forall b b' b'' p st e h exp1 exp2 p', - @realizeState ev eq f t ac (p) b st -> - validPredicate (@absEval ev eq f e b'' (exp1====exp2))=false -> +Theorem removeReplace : forall b b' b'' p st e h exp1 exp2 p', + realizeState (p) b st -> + validPredicate (absEval e b'' (exp1====exp2))=false -> b' = clipBinding b (maxBindingExp (exp1====exp2)) -> b' = clipBinding b'' (maxBindingExp (exp1====exp2)) -> st = (e,h) -> p' = removeReplaceState exp1 exp2 p -> - @realizeState ev eq f t ac (p') b st. -Proof. admit. Qed. + realizeState (p') b st. +Proof. admit. Admitted. -Fixpoint removeReplaceSameExp {ev} {eq} {f} (l : @absExp ev eq f) (loc : @absExp ev eq f) (exp : @absExp ev eq f) := +Fixpoint removeReplaceSameExp (l : absExp) (loc : absExp) (exp : absExp) := match exp with | AbsFun (AbsNthId) (p::q::nil) => match p,q with @@ -770,7 +819,7 @@ Fixpoint removeReplaceSameExp {ev} {eq} {f} (l : @absExp ev eq f) (loc : @absExp | x => x end. -Fixpoint removeReplaceSameState {ev} {eq} {f} {t} {ac} (loc1 : @absExp ev eq f) (loc2 : @absExp ev eq f) (s:@absState ev eq f t ac) : @absState ev eq f t ac := +Fixpoint removeReplaceSameState (loc1 : absExp) (loc2 : absExp) (s:absState) : absState := match s with | AbsStar s1 s2 => (AbsStar (removeReplaceSameState loc1 loc2 s1) (removeReplaceSameState loc1 loc2 s2)) | AbsOrStar s1 s2 => (AbsOrStar (removeReplaceSameState loc1 loc2 s1) (removeReplaceSameState loc1 loc2 s2)) @@ -779,42 +828,47 @@ Fixpoint removeReplaceSameState {ev} {eq} {f} {t} {ac} (loc1 : @absExp ev eq f) | AbsAll e s => AbsAll (removeReplaceSameExp loc1 loc2 e) (removeReplaceSameState loc1 loc2 s) | AbsEach e s => AbsEach (removeReplaceSameExp loc1 loc2 e) (removeReplaceSameState loc1 loc2 s) | AbsEmpty => AbsEmpty + | AbsNone => AbsNone + | AbsAny => AbsAny | AbsLeaf i l => AbsLeaf i (map (removeReplaceSameExp loc1 loc2) l) | AbsAccumulate i e1 e2 e3 => AbsAccumulate i (removeReplaceSameExp loc1 loc2 e1) (removeReplaceSameExp loc1 loc2 e2) (removeReplaceSameExp loc1 loc2 e3) | AbsMagicWand s1 s2 => AbsMagicWand (removeReplaceSameState loc1 loc2 s1) (removeReplaceSameState loc1 loc2 s2) | AbsUpdateVar s i v => AbsUpdateVar (removeReplaceSameState loc1 loc2 s) i (removeReplaceSameExp loc1 loc2 v) + | AbsUpdateWithLoc s i v => AbsUpdateWithLoc (removeReplaceSameState loc1 loc2 s) i (removeReplaceSameExp loc1 loc2 v) + | AbsUpdateLoc s i v => AbsUpdateLoc (removeReplaceSameState loc1 loc2 s) (removeReplaceSameExp loc1 loc2 i) (removeReplaceSameExp loc1 loc2 v) | AbsUpdState s1 s2 s3 => AbsUpdState (removeReplaceSameState loc1 loc2 s1) (removeReplaceSameState loc1 loc2 s2) (removeReplaceSameState loc1 loc2 s3) + | AbsClosure s l => AbsClosure s (map (removeReplaceSameExp loc1 loc2) l) end. -Theorem removeReplaceSame {ev} {eq} {f} {t} {ac} : forall b p st l loc p' ll n, - @realizeState ev eq f t ac ([p]) b st -> +Theorem removeReplaceSame : forall b p st l loc p' ll n, + realizeState ([p]) b st -> p' = removeReplaceSameExp l loc p -> - ListValue ll = @absEval ev eq f (fst st) b l -> - NatValue n = @absEval ev eq f (fst st) b loc -> + ListValue ll = absEval (fst st) b l -> + NatValue n = absEval (fst st) b loc -> n < length ll -> - @realizeState ev eq f t ac ([p']) b st. -Proof. admit. Qed. + realizeState ([p']) b st. +Proof. admit. Admitted. -Theorem realizeValidPredicate {ev} {eq} {f} {t} {ac} : forall st e h exp b, +Theorem realizeValidPredicate : forall st e h exp b, st = (e,h) -> - (validPredicate (@absEval ev eq f e b exp)=true <-> @realizeState ev eq f t ac ([exp]) b st). -Proof. admit. Qed. + (validPredicate (absEval e b exp)=true <-> realizeState ([exp]) b st). +Proof. admit. Admitted. -Theorem validPredicateSymmetry {ev} {eq} {f} : forall b e exp1 exp2, - validPredicate (@absEval ev eq f e b (exp1====exp2))= - validPredicate (@absEval ev eq f e b (exp2====exp1)). -Proof. admit. Qed. +Theorem validPredicateSymmetry : forall b e exp1 exp2, + validPredicate (absEval e b (exp1====exp2))= + validPredicate (absEval e b (exp2====exp1)). +Proof. admit. Admitted. -Function mapSum {t} {teq} {f} (env : id -> nat) (b : list (@Value t)) (values : list (@Value t)) (e : @absExp t teq f) : nat := +Function mapSum (env : id -> nat) (b : list (@Value unit)) (values : list (@Value unit)) (e : absExp) : nat := match values with | nil => 0 - | (ff::rr) => match (@absEval t teq f env (b++(ff::nil)) e) with + | (ff::rr) => match (absEval env (b++(ff::nil)) e) with | NatValue x => (mapSum env b rr e)+x | _ => mapSum env b rr e end end. -Function singlePred {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) := +Function singlePred (s : absState) := match s with | [x] => Some x | (a ** b) => match singlePred a,singlePred b with @@ -828,68 +882,68 @@ Function singlePred {ev} {eq} {f} {t} {ac} (s : @absState ev eq f t ac) := | _ => None end. -Theorem andSum8 {ev} {eq} {f} {t} {ac} : forall v0 v1 v2 v3 v4 v5 v6 v7 vv v r e s state ee, - @realizeState ev eq f t ac (SUM(r,e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::nil) s -> +Theorem andSum8 : forall v0 v1 v2 v3 v4 v5 v6 v7 vv v r e s state ee, + realizeState (SUM(r,e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::nil) s -> (forall x, In x vv -> realizeState state (v0::v1::v2::v3::v4::v5::v6::v7::x::nil) s) -> - Some ee = @singlePred ev eq f t ac state -> - (@ListValue ev vv) = @absEval ev eq f (fst s) (v0::v1::v2::v3::v4::v5::v6::v7::nil) r -> - @realizeState ev eq f t ac (SUM(r,ee //\\ e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::nil) s. -Proof. admit. Qed. + Some ee = singlePred state -> + (@ListValue unit vv) = absEval (fst s) (v0::v1::v2::v3::v4::v5::v6::v7::nil) r -> + realizeState (SUM(r,ee //\\ e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::nil) s. +Proof. admit. Admitted. -Theorem implySum8x10 {ev} {eq} {f} {t} {ac} : forall v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 vv v r e s state ee, - @realizeState ev eq f t ac (SUM(r,e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s -> +Theorem implySum8x10 : forall v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 vv v r e s state ee, + realizeState (SUM(r,e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s -> (forall x, In x vv -> realizeState state (v0::v1::v2::v3::v4::v5::v6::v7::x::nil) s) -> - Some ee = (@singlePred ev eq f t ac state) -> - (@ListValue ev vv) = @absEval ev eq f (fst s) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) r -> - @realizeState ev eq f t ac (SUM(r,(~~(addExpVar 8 (addExpVar 8 ee))) \\// e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s. -Proof. admit. Qed. + Some ee = (singlePred state) -> + (@ListValue unit vv) = absEval (fst s) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) r -> + realizeState (SUM(r,(~~(addExpVar 8 (addExpVar 8 ee))) \\// e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s. +Proof. admit. Admitted. -Theorem andSum8x10 {ev} {eq} {f} {t} {ac} : forall v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 vv v r e s state ee, - @realizeState ev eq f t ac (SUM(r,e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s -> +Theorem andSum8x10 : forall v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 vv v r e s state ee, + realizeState (SUM(r,e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s -> (forall x, In x vv -> realizeState state (v0::v1::v2::v3::v4::v5::v6::v7::x::nil) s) -> - Some ee = (@singlePred ev eq f t ac state) -> - (@ListValue ev vv) = @absEval ev eq f (fst s) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) r -> - @realizeState ev eq f t ac (SUM(r,((addExpVar 8 (addExpVar 8 ee))) //\\ e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s. -Proof. admit. Qed. + Some ee = (singlePred state) -> + (@ListValue unit vv) = absEval (fst s) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) r -> + realizeState (SUM(r,((addExpVar 8 (addExpVar 8 ee))) //\\ e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s. +Proof. admit. Admitted. -Theorem resolveSum8x10 {ev} {eq} {f} {t} {ac} : forall v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 vv v r e s state ee ff, - @realizeState ev eq f t ac (SUM(r,e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s -> +Theorem resolveSum8x10 : forall v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 vv v r e s state ee ff, + realizeState (SUM(r,e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s -> (forall x, In x vv -> realizeState state (v0::v1::v2::v3::v4::v5::v6::v7::x::nil) s) -> - Some ee = (@singlePred ev eq f t ac state) -> + Some ee = (singlePred state) -> (forall x s, In x vv -> - @realizeState ev eq f t ac ([((addExpVar 8 (addExpVar 8 ee)))]) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::x::nil) (s,empty_heap) -> - @realizeState ev eq f t ac ([e====ff]) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::x::nil) (s,empty_heap)) -> - (@ListValue ev vv) = @absEval ev eq f (fst s) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) r -> - @realizeState ev eq f t ac (SUM(r,ff,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s. -Proof. admit. Qed. - -Theorem resolveSum9x10 {ev} {eq} {f} {t} {ac} : forall v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 vv v r e s state ee ff, - @realizeState ev eq f t ac (SUM(r,e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s -> + realizeState ([((addExpVar 8 (addExpVar 8 ee)))]) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::x::nil) (s,empty_heap) -> + realizeState ([e====ff]) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::x::nil) (s,empty_heap)) -> + (@ListValue unit vv) = absEval (fst s) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) r -> + realizeState (SUM(r,ff,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s. +Proof. admit. Admitted. + +Theorem resolveSum9x10 : forall v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 vv v r e s state ee ff, + realizeState (SUM(r,e,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s -> (forall x, In x vv -> realizeState state (v0::v1::v2::v3::v4::v5::v6::v7::v8::x::nil) s) -> - Some ee = (@singlePred ev eq f t ac state) -> + Some ee = (singlePred state) -> (forall x s, In x vv -> - @realizeState ev eq f t ac ([(addExpVar 9 ee)]) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::x::nil) (s,empty_heap) -> - @realizeState ev eq f t ac ([e====ff]) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::x::nil) (s,empty_heap)) -> - (@ListValue ev vv) = @absEval ev eq f (fst s) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) r -> - @realizeState ev eq f t ac (SUM(r,ff,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s. -Proof. admit. Qed. - -Theorem sumDiff {ev} {eq} {f} {t} {ac} : forall s b r e s1 s2 sd x, - @realizeState ev eq f t ac (SUM(r,(e //\\ x),(#s1))) b s -> - @realizeState ev eq f t ac (SUM(r,e,(#s2))) b s -> + realizeState ([(addExpVar 9 ee)]) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::x::nil) (s,empty_heap) -> + realizeState ([e====ff]) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::x::nil) (s,empty_heap)) -> + (@ListValue unit vv) = absEval (fst s) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) r -> + realizeState (SUM(r,ff,v)) (v0::v1::v2::v3::v4::v5::v6::v7::v8::v9::nil) s. +Proof. admit. Admitted. + +Theorem sumDiff : forall s b r e s1 s2 sd x, + realizeState (SUM(r,(e //\\ x),(#s1))) b s -> + realizeState (SUM(r,e,(#s2))) b s -> sd = s2-s1 -> - @realizeState ev eq f t ac (SUM(r,(e //\\ (~~x)),(#sd))) b s. -Proof. admit. Qed. + realizeState (SUM(r,(e //\\ (~~x)),(#sd))) b s. +Proof. admit. Admitted. -Theorem sumAllConv {ev} {eq} {f} {t} {ac} : forall r e b s, - @realizeState ev eq f t ac (SUM(r,e,#0)) b s -> - @realizeState ev eq f t ac (AbsAll r ([~~e])) b s. -Proof. admit. Qed. +Theorem sumAllConv : forall r e b s, + realizeState (SUM(r,e,#0)) b s -> + realizeState (AbsAll r ([~~e])) b s. +Proof. admit. Admitted. Function deletenth {t} (x : nat) (l : list t) := match x,l with @@ -901,37 +955,37 @@ Function deletenth {t} (x : nat) (l : list t) := | _,_ => None end. -Theorem dumpVar {ev} {eq} {f} {t} {ac} : forall state b s n b', - @realizeState ev eq f t ac state b s -> +Theorem dumpVar : forall state b s n b', + realizeState state b s -> hasVnState state n=false -> Some b' = deletenth n b -> - @realizeState ev eq f t ac (removeStateVar n state) b' s. -Proof. admit. Qed. + realizeState (removeStateVar n state) b' s. +Proof. admit. Admitted. -Theorem dumpVar2 {ev} {eq} {f} {t} {ac} : forall state b s n b', - @realizeState ev eq f t ac (removeStateVar n state) b' s -> +Theorem dumpVar2 : forall state b s n b', + realizeState (removeStateVar n state) b' s -> hasVnState state n=false -> Some b' = deletenth n b -> - @realizeState ev eq f t ac state b s. -Proof. admit. Qed. + realizeState state b s. +Proof. admit. Admitted. -Theorem mapSumExists {ev} {eq} {f} {t} {ac} : forall v e b vals exp, - S v = @mapSum ev eq f e b vals exp -> - exists x, In x vals /\ @realizeState ev eq f t ac ([exp]) (b++(x::nil)) (e,empty_heap). -Proof. admit. Qed. +Theorem mapSumExists : forall v e b vals exp, + S v = mapSum e b vals exp -> + exists x, In x vals /\ realizeState ([exp]) (b++(x::nil)) (e,empty_heap). +Proof. admit. Admitted. -Theorem mapSumNeg {ev} {eq} {f} {t} {ac} : forall e b vals exp, - 0 = @mapSum ev eq f e b vals exp -> - forall x, In x vals -> @realizeState ev eq f t ac ([~~exp]) (b++(x::nil)) (e,empty_heap). -Proof. admit. Qed. +Theorem mapSumNeg : forall e b vals exp, + 0 = mapSum e b vals exp -> + forall x, In x vals -> realizeState ([~~exp]) (b++(x::nil)) (e,empty_heap). +Proof. admit. Admitted. Theorem subRangeSet {ev} : forall x rl rl0 n v, - rangeSet (@findRecord ev n v) = ListValue rl0 -> + rangeSet (ListValue (@findRecord ev n v)) = ListValue rl0 -> In x rl0 -> In (@NatValue ev n) rl -> rangeSet v = ListValue rl -> In x rl. -Proof. admit. Qed. +Proof. admit. Admitted. Function replacenth {t} (x : nat) (e : t) (l : list t) := match x,l with @@ -943,29 +997,93 @@ Function replacenth {t} (x : nat) (e : t) (l : list t) := | _,_ => None end. -Theorem subBoundVar {ev} {eq} {f} {t} {ac} : forall b eee exp b' p p' n, - nth n b' NoValue = @absEval ev eq f eee b exp -> - @realizeState ev eq f t ac p b' (eee, empty_heap) -> +Theorem subBoundVar : forall b eee exp b' p p' n, + nth n b' NoValue = absEval eee b exp -> + realizeState p b' (eee, empty_heap) -> Some b = replacenth n (nth n b NoValue) b' -> p' = replaceState p v(n) exp -> - @realizeState ev eq f t ac p' b (eee,empty_heap). -Proof. admit. Qed. + realizeState p' b (eee,empty_heap). +Proof. admit. Admitted. -Theorem arrayLength {ev} {eq} {f} {t} {ac} : forall v len n b st l, - @realizeState ev eq f t ac (ARRAY(v,#len,v(n))) b st -> +Theorem arrayLength : forall v len n b st l, + realizeState (ARRAY(v,#len,v(n))) b st -> nth n b NoValue = ListValue l -> length l = len. -Proof. admit. Qed. +Proof. admit. Admitted. + +Theorem sumExists : forall b eee r e n, + realizeState (SUM(r,e,(#(S n)))) b (eee,empty_heap) -> + realizeState (AbsExists r ([e])) b (eee,empty_heap). +Proof. admit. Admitted. + +Theorem reverse: forall st x y b, + realizeState ([x====y]) b st -> + realizeState ([y====x]) b st. +Proof. admit. Admitted. + +Theorem entailmentUnusedUpdated : forall s b state v e, + realizeState (AbsUpdateVar state v e) b s -> + hasVarState state v=false -> + realizeState state b s. +Proof. + admit. +Admitted. + + +Function allEmpty (s : absState) := + match s with + | AbsEmpty => true + | AbsStar a b => if allEmpty a then allEmpty b else false + | AbsOrStar a b => if allEmpty a then allEmpty b else false + | _ => false + end. + +Theorem emptyRealizeState : forall s b e, + allEmpty(s)=true -> + @realizeState s b (e,empty_heap). +Proof. + admit. +Admitted. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -Theorem sumExists {ev} {eq} {f} {t} {ac} : forall b eee r e n, - @realizeState ev eq f t ac (SUM(r,e,(#(S n)))) b (eee,empty_heap) -> - @realizeState ev eq f t ac (AbsExists r ([e])) b (eee,empty_heap). -Proof. admit. Qed. -Theorem reverse {ev} {eq} {f} {t} {ac} : forall st x y b, - @realizeState ev eq f t ac ([x====y]) b st -> - @realizeState ev eq f t ac ([y====x]) b st. -Proof. admit. Qed. diff --git a/PEDANTIC/xxx.v b/PEDANTIC/xxx.v new file mode 100644 index 0000000..08780c3 --- /dev/null +++ b/PEDANTIC/xxx.v @@ -0,0 +1,35 @@ + Inductive var : list Type -> Type -> Type := + | VO : forall T Ts, var (T :: Ts) T + | VS : forall T Ts T', var Ts T -> var (T' :: Ts) T. + + Implicit Arguments VO [T Ts]. + Implicit Arguments VS [T Ts T']. + + Inductive propX (G : list Type) : Type := + | Inj : Prop -> propX G + | Cptr : nat -> (nat -> propX G) -> propX G + | And : propX G -> propX G -> propX G + | Or : propX G -> propX G -> propX G + | Imply : propX G -> propX G -> propX G + | Forall : forall A, (A -> propX G) -> propX G + | Exists : forall A, (A -> propX G) -> propX G + + | Var : forall A, var G A -> A -> propX G + | ForallX : forall A, propX (A :: G) -> propX G + | ExistsX : forall A, propX (A :: G) -> propX G. + + Implicit Arguments Inj [G]. + + Definition PropX := propX nil. + +Fixpoint liftV G T (v : var G T) G' : var (G ++ G') T := + match v with + | VO _ _ => VO + | VS _ _ _ v' => VS (liftV _ _ v' _) + end. + + Fixpoint liftV G T (v : var G T) G' : var (G ++ G') T := + match v with + | VO _ _ => VO + | VS _ _ _ v' => VS (liftV v' _) + end. \ No newline at end of file