diff --git a/Frap.v b/Frap.v index a49b116..245a755 100644 --- a/Frap.v +++ b/Frap.v @@ -43,7 +43,7 @@ Ltac invert0 e := invert e; fail. Ltac invert1 e := invert0 e || (invert e; []). Ltac invert2 e := invert1 e || (invert e; [|]). -Ltac simplify := repeat progress (simpl in *; intros; try autorewrite with core in *). +Ltac simplify := repeat progress (simpl in *; intros; try autorewrite with core in *); repeat removeDups. Ltac propositional := intuition idtac. Ltac linear_arithmetic := intros; diff --git a/ModelChecking.v b/ModelChecking.v index cf8251c..94e18ce 100644 --- a/ModelChecking.v +++ b/ModelChecking.v @@ -190,9 +190,6 @@ Proof. apply oneStepClosure_split; simplify. invert H; simplify. apply singleton_in. - apply oneStepClosure_split; simplify. - invert H; simplify. - apply singleton_in. apply oneStepClosure_empty. simplify. @@ -202,10 +199,55 @@ Proof. propositional; invert H0; try equality. invert H; equality. invert H1; equality. - invert H; equality. - invert H; try equality. simplify. propositional; subst; simplify; propositional. (* ^-- *) Qed. + +Hint Rewrite fact_init_is. + +Ltac model_check_done := + apply MscDone; apply prove_oneStepClosure; simplify; propositional; subst; + repeat match goal with + | [ H : _ |- _ ] => invert H + end; simplify; equality. + +Ltac model_check_step := + eapply MscStep; [ + repeat ((apply oneStepClosure_empty; simplify) + || (apply oneStepClosure_split; [ simplify; + repeat match goal with + | [ H : _ |- _ ] => invert H + end; apply singleton_in | ])) + | simplify ]. + +Ltac model_check_steps1 := model_check_done || model_check_step. +Ltac model_check_steps := repeat model_check_steps1. + +Ltac model_check_finish := simplify; propositional; subst; simplify; equality. + +Ltac model_check_find_invariant := + simplify; eapply invariantFor_weaken; [ + apply multiStepClosure_ok; simplify; model_check_steps + | ]. + +Ltac model_check := model_check_find_invariant; model_check_finish. + +Theorem factorial_ok_2_snazzy : + invariantFor (factorial_sys 2) (fact_correct 2). +Proof. + model_check. +Qed. + +Theorem factorial_ok_3 : + invariantFor (factorial_sys 3) (fact_correct 3). +Proof. + model_check. +Qed. + +Theorem factorial_ok_4 : + invariantFor (factorial_sys 4) (fact_correct 4). +Proof. + model_check. +Qed. diff --git a/Sets.v b/Sets.v index 2e7923b..bf91761 100644 --- a/Sets.v +++ b/Sets.v @@ -126,3 +126,52 @@ End properties. Hint Resolve subseteq_refl subseteq_In. Hint Rewrite union_constant. + + +(** * Removing duplicates from constant sets *) + +Inductive removeDups A : list A -> list A -> Prop := +| RdNil : removeDups nil nil +| RdNew : forall x ls ls', + ~List.In x ls + -> removeDups ls ls' + -> removeDups (x :: ls) (x :: ls') +| RdDup : forall x ls ls', + List.In x ls + -> removeDups ls ls' + -> removeDups (x :: ls) ls'. + +Theorem removeDups_fwd : forall A x (ls ls' : list A), + removeDups ls ls' + -> List.In x ls + -> List.In x ls'. +Proof. + induction 1; simpl; intuition. + subst; eauto. +Qed. + +Theorem removeDups_bwd : forall A x (ls ls' : list A), + removeDups ls ls' + -> List.In x ls' + -> List.In x ls. +Proof. + induction 1; simpl; intuition. +Qed. + +Theorem removeDups_ok : forall A (ls ls' : list A), + removeDups ls ls' + -> constant ls = constant ls'. +Proof. + intros. + apply sets_equal. + unfold constant; intuition eauto using removeDups_fwd, removeDups_bwd. +Qed. + +Ltac removeDups := + match goal with + | [ |- context[constant ?ls] ] => + erewrite (@removeDups_ok _ ls) + by repeat (apply RdNil + || (apply RdNew; [ simpl; intuition congruence | ]) + || (apply RdDup; [ simpl; intuition congruence | ])) + end.