You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

#### 647 lines 26 KiB Coq Raw Blame History

 ```Require Import Coq.ZArith.Int. ``` ```Require Import Coq.Lists.ListSet. ``` ```Require Import Coq.Vectors.VectorDef. ``` ```Require Import Coq.Vectors.Fin. ``` ```Require Import Coq.Program.Equality. ``` ```Require Import Coq.Logic.Eqdep_dec. ``` ```Require Import Coq.Arith.Peano_dec. ``` ``` ``` ```Module DayEight (Import M:Int). ``` ``` (* We need to coerce natural numbers into integers to add them. *) ``` ``` Parameter nat_to_t : nat -> t. ``` ``` (* We need a way to convert integers back into finite sets. *) ``` ``` Parameter clamp : forall {n}, t -> option (Fin.t n). ``` ``` ``` ``` Definition fin := Fin.t. ``` ``` ``` ``` (* The opcode of our instructions. *) ``` ``` Inductive opcode : Type := ``` ``` | add ``` ``` | nop ``` ``` | jmp. ``` ``` ``` ``` (* The result of running a program is either the accumulator ``` ``` or an infinite loop error. In the latter case, we return the ``` ``` set of instructions that we tried. *) ``` ``` Inductive run_result {n : nat} : Type := ``` ``` | Ok : t -> run_result ``` ``` | Fail : set (fin n) -> run_result. ``` ``` ``` ``` Definition state n : Type := (fin (S n) * set (fin n) * t). ``` ``` ``` ``` (* An instruction is a pair of an opcode and an argument. *) ``` ``` Definition inst : Type := (opcode * t). ``` ``` (* An input is a bounded list of instructions. *) ``` ``` Definition input (n : nat) := VectorDef.t inst n. ``` ``` (* 'indices' represents the list of instruction ``` ``` addresses, which are used for calculating jumps. *) ``` ``` Definition indices (n : nat) := VectorDef.t (fin n) n. ``` ``` ``` ``` (* Compute the destination jump index, an integer. *) ``` ``` Definition jump_t {n} (pc : fin n) (off : t) : t := ``` ``` M.add (nat_to_t (proj1_sig (to_nat pc))) off. ``` ``` ``` ``` (* Compute a destination index that's valid. ``` ``` Not all inputs are valid, so this may fail. *) ``` ``` Definition valid_jump_t {n} (pc : fin n) (off : t) : option (fin (S n)) := @clamp (S n) (jump_t pc off). ``` ``` ``` ``` Fixpoint weaken_one {n} (f : fin n) : fin (S n) := ``` ``` match f with ``` ``` | F1 => F1 ``` ``` | FS f' => FS (weaken_one f') ``` ``` end. ``` ``` ``` ``` Fixpoint nat_to_fin (n : nat) : fin (S n) := ``` ``` match n with ``` ``` | O => F1 ``` ``` | S n' => FS (nat_to_fin n') ``` ``` end. ``` ``` ``` ``` Lemma fin_big_or_small : forall {n} (f : fin (S n)), ``` ``` (f = nat_to_fin n) \/ (exists (f' : fin n), f = weaken_one f'). ``` ``` Proof. ``` ``` (* Hey, looks like the creator of Fin provided ``` ``` us with nice inductive principles. Using Coq's ``` ``` default `induction` breaks here. ``` ``` ``` ``` Merci, Pierre! *) ``` ``` apply Fin.rectS. ``` ``` - intros n. destruct n. ``` ``` + left. reflexivity. ``` ``` + right. exists F1. auto. ``` ``` - intros n p IH. ``` ``` destruct IH. ``` ``` + left. rewrite H. reflexivity. ``` ``` + right. destruct H as [f' Heq]. ``` ``` exists (FS f'). simpl. rewrite Heq. ``` ``` reflexivity. ``` ``` Qed. ``` ``` ``` ``` Lemma weaken_one_inj : forall n (f1 f2 : fin n), ``` ``` (weaken_one f1 = weaken_one f2 -> f1 = f2). ``` ``` Proof. ``` ``` remember (fun {n} (a b : fin n) => weaken_one a = weaken_one b -> a = b) as P. ``` ``` (* Base case for rect2 *) ``` ``` assert (forall n, @P (S n) F1 F1). ``` ``` {rewrite HeqP. intros n Heq. reflexivity. } ``` ``` (* 'Impossible' cases for rect2. *) ``` ``` assert (forall {n} (f : fin n), P (S n) F1 (FS f)). ``` ``` {rewrite HeqP. intros n f Heq. simpl in Heq. inversion Heq. } ``` ``` assert (forall {n} (f : fin n), P (S n) (FS f) F1). ``` ``` {rewrite HeqP. intros n f Heq. simpl in Heq. inversion Heq. } ``` ``` (* Recursive case for rect2. *) ``` ``` assert (forall {n} (f g : fin n), P n f g -> P (S n) (FS f) (FS g)). ``` ``` {rewrite HeqP. intros n f g IH Heq. ``` ``` simpl in Heq. injection Heq as Heq'. ``` ``` apply inj_pair2_eq_dec in Heq'. ``` ``` - rewrite IH. reflexivity. assumption. ``` ``` - apply eq_nat_dec. } ``` ``` ``` ``` (* Actually apply recursion. *) ``` ``` (* This can't be _the_ way to do this. *) ``` ``` intros n. ``` ``` specialize (@Fin.rect2 P H H0 H1 H2 n) as Hind. ``` ``` rewrite HeqP in Hind. apply Hind. ``` ``` Qed. ``` ``` ``` ``` Lemma weaken_neq_to_fin : forall {n} (f : fin (S n)), ``` ``` nat_to_fin (S n) <> weaken_one f. ``` ``` Proof. ``` ``` apply Fin.rectS; intros n Heq. ``` ``` - inversion Heq. ``` ``` - intros IH. simpl. intros Heq'. ``` ``` injection Heq' as Hinj. apply inj_pair2_eq_dec in Hinj. ``` ``` + simpl in IH. apply IH. apply Hinj. ``` ``` + apply eq_nat_dec. ``` ``` Qed. ``` ``` ``` ``` (* One modification: we really want to use 'allowed' addresses, ``` ``` a set that shrinks as the program continues, rather than 'visited' ``` ``` addresses, a set that increases as the program continues. *) ``` ``` Inductive step_noswap {n} : input n -> state n -> state n -> Prop := ``` ``` | step_noswap_add : forall inp pc' v acc t, ``` ``` nth inp pc' = (add, t) -> ``` ``` set_In pc' v -> ``` ``` step_noswap inp (weaken_one pc', v, acc) (FS pc', set_remove Fin.eq_dec pc' v, M.add acc t) ``` ``` | step_noswap_nop : forall inp pc' v acc t, ``` ``` nth inp pc' = (nop, t) -> ``` ``` set_In pc' v -> ``` ``` step_noswap inp (weaken_one pc', v, acc) (FS pc', set_remove Fin.eq_dec pc' v, acc) ``` ``` | step_noswap_jmp : forall inp pc' pc'' v acc t, ``` ``` nth inp pc' = (jmp, t) -> ``` ``` set_In pc' v -> ``` ``` valid_jump_t pc' t = Some pc'' -> ``` ``` step_noswap inp (weaken_one pc', v, acc) (pc'', set_remove Fin.eq_dec pc' v, acc). ``` ``` ``` ``` Inductive done {n} : input n -> state n -> Prop := ``` ``` | done_prog : forall inp v acc, done inp (nat_to_fin n, v, acc). ``` ``` ``` ``` Inductive stuck {n} : input n -> state n -> Prop := ``` ``` | stuck_prog : forall inp pc' v acc, ``` ``` ~ set_In pc' v -> stuck inp (weaken_one pc', v, acc). ``` ``` ``` ``` Inductive run_noswap {n} : input n -> state n -> state n -> Prop := ``` ``` | run_noswap_ok : forall inp st, done inp st -> run_noswap inp st st ``` ``` | run_noswap_fail : forall inp st, stuck inp st -> run_noswap inp st st ``` ``` | run_noswap_trans : forall inp st st' st'', ``` ``` step_noswap inp st st' -> run_noswap inp st' st'' -> run_noswap inp st st''. ``` ``` ``` ``` Inductive valid_inst {n} : inst -> fin n -> Prop := ``` ``` | valid_inst_add : forall t f, valid_inst (add, t) f ``` ``` | valid_inst_nop : forall t f f', ``` ``` valid_jump_t f t = Some f' -> valid_inst (nop, t) f ``` ``` | valid_inst_jmp : forall t f f', ``` ``` valid_jump_t f t = Some f' -> valid_inst (jmp, t) f. ``` ``` ``` ``` (* An input is valid if all its instructions are valid. *) ``` ``` Definition valid_input {n} (inp : input n) : Prop := forall (pc : fin n), ``` ``` valid_inst (nth inp pc) pc. ``` ``` ``` ``` Section ValidInput. ``` ``` Variable n : nat. ``` ``` Variable inp : input n. ``` ``` Hypothesis Hv : valid_input inp. ``` ``` ``` ``` Lemma step_if_possible : forall pcs v acc, ``` ``` set_In pcs v -> ``` ``` exists pc' acc', step_noswap inp (weaken_one pcs, v, acc) (pc', set_remove Fin.eq_dec pcs v, acc'). ``` ``` Proof. ``` ``` intros pcs v acc Hin. ``` ``` remember (nth inp pcs) as instr. destruct instr as [op t]. destruct op. ``` ``` + exists (FS pcs). exists (M.add acc t). apply step_noswap_add; auto. ``` ``` + exists (FS pcs). exists acc. apply step_noswap_nop with t; auto. ``` ``` + unfold valid_input in Hv. specialize (Hv pcs). ``` ``` rewrite <- Heqinstr in Hv. inversion Hv; subst. ``` ``` exists f'. exists acc. apply step_noswap_jmp with t; auto. ``` ``` Qed. ``` ``` ``` ``` Theorem valid_input_progress : forall pc v acc, ``` ``` (pc = nat_to_fin n /\ done inp (pc, v, acc)) \/ ``` ``` exists pcs, pc = weaken_one pcs /\ ``` ``` ((~ set_In pcs v /\ stuck inp (pc, v, acc)) \/ ``` ``` (exists pc' acc', set_In pcs v /\ step_noswap inp (pc, v, acc) (pc', set_remove Fin.eq_dec pcs v, acc'))). ``` ``` Proof. ``` ``` intros pc v acc. ``` ``` (* Have we reached the end? *) ``` ``` destruct (fin_big_or_small pc). ``` ``` (* We're at the end, so we're done. *) ``` ``` left. rewrite H. split. reflexivity. apply done_prog. ``` ``` (* We're not at the end. Is the PC valid? *) ``` ``` right. destruct H as [pcs H]. exists pcs. rewrite H. split. reflexivity. ``` ``` destruct (set_In_dec Fin.eq_dec pcs v). ``` ``` - (* It is. *) ``` ``` right. ``` ``` destruct (step_if_possible pcs v acc) as [pc' [acc' Hstep]]; auto. ``` ``` exists pc'. exists acc'. split; auto. ``` ``` - (* It i not. *) ``` ``` left. split; auto. apply stuck_prog; auto. ``` ``` Qed. ``` ``` ``` ``` Theorem run_ok_or_fail : forall st st', ``` ``` run_noswap inp st st' -> ``` ``` (exists v acc, st' = (nat_to_fin n, v, acc) /\ done inp st') \/ ``` ``` (exists pcs v acc, st' = (weaken_one pcs, v, acc) /\ stuck inp st'). ``` ``` Proof. ``` ``` intros st st' Hr. ``` ``` induction Hr. ``` ``` - left. inversion H; subst. exists v. exists acc. auto. ``` ``` - right. inversion H; subst. exists pc'. exists v. exists acc. auto. ``` ``` - apply IHHr; auto. ``` ``` Qed. ``` ``` ``` ``` Theorem set_induction {A : Type} ``` ``` (Aeq_dec : forall (x y : A), { x = y } + { x <> y }) ``` ``` (P : set A -> Prop) : ``` ``` P (@empty_set A) -> (forall a st, P (set_remove Aeq_dec a st) -> P st) -> ``` ``` forall st, P st. ``` ``` Proof. Admitted. ``` ``` ``` ``` (* Theorem add_terminates_later : forall pcs a v acc, ``` ``` List.NoDup v -> pcs <> a -> ``` ``` (forall pc' acc', exists st', run_noswap inp (pc', set_remove Fin.eq_dec a v, acc') st') -> ``` ``` exists st', run_noswap inp (weaken_one pcs, v, acc) st'. ``` ``` Proof. ``` ``` intros pcs a v acc Hnd Hneq He. ``` ``` assert (exists st', run_noswap inp (weaken_one pcs, set_remove Fin.eq_dec a v, acc) st'). ``` ``` { specialize (He (weaken_one pcs) acc). apply He. } ``` ``` destruct H as [st' Hr]. ``` ``` inversion Hr; subst. ``` ``` - inversion H. destruct n. inversion pcs. apply weaken_neq_to_fin in H2 as []. ``` ``` - inversion H; subst. apply weaken_one_inj in H0. subst. ``` ``` eexists. eapply run_noswap_fail. apply stuck_prog. ``` ``` intros Hin. apply H2. apply set_remove_3; auto. ``` ``` - ``` ``` inversion H; subst; apply weaken_one_inj in H1; subst. ``` ``` + eexists. eapply run_noswap_trans. apply step_noswap_add. ``` ``` * apply H6. ``` ``` * apply (@set_remove_1 _ Fin.eq_dec pcs a v H7). ``` ``` * ``` ``` ``` ``` destruct He as [st' Hr]. ``` ``` dependent induction Hr. ``` ``` - inversion H. destruct n. inversion pcs. apply weaken_neq_to_fin in H2 as []. ``` ``` - inversion H; subst. apply weaken_one_inj in H0. subst. ``` ``` eexists. eapply run_noswap_fail. apply stuck_prog. ``` ``` intros Hin. apply H2. apply set_remove_3; auto. ``` ``` - destruct st' as [[pc' v'] a']. *) ``` ``` ``` ``` Lemma set_remove_comm : forall {A:Type} Aeq_dec a b (st : set A), ``` ``` set_remove Aeq_dec a (set_remove Aeq_dec b st) = set_remove Aeq_dec b (set_remove Aeq_dec a st). ``` ``` Admitted. ``` ``` ``` ``` Theorem remove_pc_safe : forall pc a v acc, ``` ``` List.NoDup v -> ``` ``` (exists st', run_noswap inp (pc, v, acc) st') -> ``` ``` exists st', run_noswap inp (pc, set_remove Fin.eq_dec a v, acc) st'. ``` ``` Proof. ``` ``` intros pc a v acc Hnd [st' He]. ``` ``` dependent induction He. ``` ``` - inversion H; subst. ``` ``` eexists. apply run_noswap_ok. apply done_prog. ``` ``` - inversion H; subst. ``` ``` eexists. apply run_noswap_fail. apply stuck_prog. ``` ``` intros Contra. apply H2. eapply set_remove_1. apply Contra. ``` ``` - destruct st' as [[pc' v'] acc']. ``` ``` inversion H; subst; destruct (Fin.eq_dec pc'0 a); subst. ``` ``` + eexists. apply run_noswap_fail. apply stuck_prog. ``` ``` intros Contra. apply set_remove_2 in Contra; auto. ``` ``` + edestruct IHHe; auto. apply set_remove_nodup; auto. ``` ``` eexists. eapply run_noswap_trans. ``` ``` * apply step_noswap_add. apply H3. apply set_remove_iff; auto. ``` ``` * rewrite set_remove_comm. apply H0. ``` ``` + eexists. apply run_noswap_fail. apply stuck_prog. ``` ``` intros Contra. apply set_remove_2 in Contra; auto. ``` ``` + edestruct IHHe; auto. apply set_remove_nodup; auto. ``` ``` eexists. eapply run_noswap_trans. ``` ``` * apply step_noswap_nop with t0. apply H3. apply set_remove_iff; auto. ``` ``` * rewrite set_remove_comm. apply H0. ``` ``` + eexists. apply run_noswap_fail. apply stuck_prog. ``` ``` intros Contra. apply set_remove_2 in Contra; auto. ``` ``` + edestruct IHHe; auto. apply set_remove_nodup; auto. ``` ``` eexists. eapply run_noswap_trans. ``` ``` * apply step_noswap_jmp with t0. apply H5. apply set_remove_iff; auto. ``` ``` apply H9. ``` ``` * rewrite set_remove_comm. apply H0. ``` ``` Qed. ``` ``` ``` ``` Theorem valid_input_terminates : forall pc v acc, ``` ``` List.NoDup v -> exists st', run_noswap inp (pc, v, acc) st'. ``` ``` Proof. ``` ``` intros pc v acc. ``` ``` generalize dependent pc. generalize dependent acc. ``` ``` induction v as [|a v] using (@set_induction _ Fin.eq_dec); intros acc pc Hnd. ``` ``` - destruct (valid_input_progress pc (empty_set _) acc) as [|[pcs [Hpc []]]]. ``` ``` + (* The program is done at this PC. *) ``` ``` destruct H as [Hpc Hd]. ``` ``` eexists. apply run_noswap_ok. auto. ``` ``` + (* The PC is not done, so we must have failed. *) ``` ``` destruct H as [Hin Hst]. ``` ``` eexists. apply run_noswap_fail. auto. ``` ``` + (* The program can't possibly take a step if ``` ``` it's not done and the set of valid PCs is ``` ``` empty. This case is absurd. *) ``` ``` destruct H as [pc' [acc' [Hin Hstep]]]. ``` ``` inversion Hstep; subst; inversion H6. ``` ``` - (* How did the program terminate? *) ``` ``` destruct (valid_input_progress pc (set_remove Fin.eq_dec a v) acc) as [|[pcs H]]. ``` ``` + (* We were done without a, so we're still done now. *) ``` ``` destruct H as [Hpc Hd]. rewrite Hpc. ``` ``` eexists. apply run_noswap_ok. apply done_prog. ``` ``` + (* We were not done without a. *) ``` ``` destruct H as [Hw H]. ``` ``` (* Is a equal to the current address? *) ``` ``` destruct (Fin.eq_dec pcs a) as [Heq_dec|Heq_dec]. ``` ``` * (* a is equal to the current address. Now, we can resume, ``` ``` even though we couldn't have before. *) ``` ``` subst. destruct H. ``` ``` { destruct (set_In_dec Fin.eq_dec a v). ``` ``` - destruct (step_if_possible a v acc s) as [pc' [acc' Hstep]]. ``` ``` destruct (IHv acc' pc') as [st' Hr]. ``` ``` apply set_remove_nodup. auto. ``` ``` exists st'. eapply run_noswap_trans. apply Hstep. apply Hr. ``` ``` - eexists. apply run_noswap_fail. apply stuck_prog. assumption. } ``` ``` { destruct H as [pc' [acc' [Hf]]]. ``` ``` exfalso. apply set_remove_2 in Hf. apply Hf. auto. auto. } ``` ``` * (* a is not equal to the current address. ``` ``` This case is not straightforward. *) ``` ``` subst. destruct H. ``` ``` { (* We were stuck without a, and since PC is not a, we're no less ``` ``` stuck now. *) ``` ``` destruct H. eexists. eapply run_noswap_fail. apply stuck_prog. ``` ``` intros Hin. apply H. apply set_remove_iff; auto. } ``` ``` { (* We could move on without a. We can move on still. *) ``` ``` destruct H as [pc' [acc' [Hin Hs]]]. ``` ``` destruct (step_if_possible pcs v acc) as [pc'' [acc'' Hs']]. ``` ``` - apply (set_remove_1 Fin.eq_dec pcs a v Hin). ``` ``` - eexists. eapply run_noswap_trans. apply Hs'. ``` ``` destruct (IHv acc'' pc'') as [st' Hr]. ``` ``` + apply set_remove_nodup; auto. ``` ``` + specialize (IHv acc'' pc'') as IH. ``` ``` Admitted. ``` ``` ``` ``` (* specialize (IHv acc pc (set_remove_nodup Fin.eq_dec a Hnd)) as [st' Hr]. ``` ``` dependent induction Hr; subst. ``` ``` { inversion H0. destruct n. inversion pcs. apply weaken_neq_to_fin in H3 as []. } ``` ``` { destruct H. ``` ``` - eexists. apply run_noswap_fail. apply stuck_prog. ``` ``` intros Hin. specialize (set_remove_3 Fin.eq_dec v Hin Heq_dec) as Hin'. ``` ``` destruct H. apply H. apply Hin'. ``` ``` - destruct H as [pc' [acc' [Hin Hstep]]]. ``` ``` inversion H0; subst. apply weaken_one_inj in H. subst. ``` ``` exfalso. apply H2. apply Hin. } ``` ``` { destruct H. ``` ``` - destruct H as [Hin Hst]. ``` ``` inversion H0; subst; apply weaken_one_inj in H; subst; ``` ``` exfalso; apply Hin; assumption. ``` ``` - assert (weaken_one pcs = weaken_one pcs) as Hrefl by reflexivity. ``` ``` specialize (IHHr Hv0 (weaken_one pcs) Hrefl acc v Hnd a (or_intror H) Heq_dec Hv). ``` ``` apply IHHr. ``` ``` ``` ``` (* We were broken without a, but now we could be working again. *) ``` ``` destruct H as [Hin Hst]. rewrite Hpc. admit. ``` ``` + (* We could make a step without the a. We can still do so now. *) ``` ``` ``` ``` ``` ``` destruct H as [pc' [acc' [Hin Hstep]]]. ``` ``` destruct (IHv acc pc) as [st' Hr]. inversion Hr. ``` ``` * inversion H; subst. ``` ``` destruct n. inversion pcs. apply weaken_neq_to_fin in H5 as []. ``` ``` * inversion H; subst. ``` ``` apply weaken_one_inj in H3. subst. ``` ``` exfalso. apply H5. apply Hin. ``` ``` * subst. apply set_remove_1 in Hin. ``` ``` destruct (step_if_possible pcs v acc Hin) as [pc'' [acc'' Hstep']]. ``` ``` eexists. eapply run_noswap_trans. ``` ``` apply Hstep'. specialize (IHv acc'' pc'') as [st''' Hr']. ``` ``` ``` ``` ``` ``` destruct (fin_big_or_small pc). ``` ``` (* If we're at the end, we're done. *) ``` ``` eexists. rewrite H. eapply run_noswap_ok. ``` ``` (* We're not at the end. *) *) ``` ``` End ValidInput. ``` ``` (* ``` ``` ``` ``` Lemma set_add_idempotent : forall {A:Type} ``` ``` (Aeq_dec : forall x y : A, { x = y } + { x <> y }) ``` ``` (a : A) (s : set A), set_mem Aeq_dec a s = true -> set_add Aeq_dec a s = s. ``` ``` Proof. ``` ``` intros A Aeq_dec a s Hin. ``` ``` induction s. ``` ``` - inversion Hin. ``` ``` - simpl. simpl in Hin. ``` ``` destruct (Aeq_dec a a0). ``` ``` + reflexivity. ``` ``` + simpl. rewrite IHs; auto. ``` ``` Qed. ``` ``` ``` ``` Theorem set_add_append : forall {A:Type} ``` ``` (Aeq_dec : forall x y : A, {x = y } + { x <> y }) ``` ``` (a : A) (s : set A), set_mem Aeq_dec a s = false -> ``` ``` set_add Aeq_dec a s = List.app s (List.cons a List.nil). ``` ``` Proof. ``` ``` induction s. ``` ``` - reflexivity. ``` ``` - intros Hnm. simpl in Hnm. ``` ``` destruct (Aeq_dec a a0) eqn:Heq_dec. ``` ``` + inversion Hnm. ``` ``` + simpl. rewrite Heq_dec. rewrite IHs. ``` ``` reflexivity. assumption. ``` ``` Qed. ``` ``` ``` ``` Lemma list_append_or_nil : forall {A:Type} (l : list A), ``` ``` l = List.nil \/ exists l' a, l = List.app l' (List.cons a List.nil). ``` ``` Proof. ``` ``` induction l. ``` ``` - left. reflexivity. ``` ``` - right. destruct IHl. ``` ``` + exists List.nil. exists a. ``` ``` rewrite H. reflexivity. ``` ``` + destruct H as [l' [a' H]]. ``` ``` exists (List.cons a l'). exists a'. ``` ``` rewrite H. reflexivity. ``` ``` Qed. ``` ``` ``` ``` Theorem list_append_induction : forall {A:Type} ``` ``` (P : list A -> Prop), ``` ``` P List.nil -> (forall (a : A) (l : list A), P l -> P (List.app l (List.cons a (List.nil)))) -> ``` ``` forall l, P l. ``` ``` Proof. Admitted. ``` ``` ``` ``` ``` ``` Theorem set_induction : forall {A:Type} ``` ``` (Aeq_dec : forall x y : A, { x = y } + {x <> y }) ``` ``` (P : set A -> Prop), ``` ``` P (@empty_set A) -> (forall (a : A) (s' : set A), P s' -> P (set_add Aeq_dec a s')) -> ``` ``` forall (s : set A), P s. ``` ``` Proof. Admitted. ``` ``` ``` ``` Lemma add_pc_safe_step : forall {n} (inp : input n) (pc : fin (S n)) i is acc st', ``` ``` step_noswap inp (pc, is, acc) st' -> ``` ``` exists st'', step_noswap inp (pc, (set_add Fin.eq_dec i is), acc) st''. ``` ``` Proof. ``` ``` intros n inp pc' i is acc st' Hstep. ``` ``` inversion Hstep. ``` ``` - eexists. apply step_noswap_add. apply H4. ``` ``` apply set_mem_correct2. apply set_add_intro1. ``` ``` apply set_mem_correct1 with Fin.eq_dec. assumption. ``` ``` - eexists. eapply step_noswap_nop. apply H4. ``` ``` apply set_mem_correct2. apply set_add_intro1. ``` ``` apply set_mem_correct1 with Fin.eq_dec. assumption. ``` ``` - eexists. eapply step_noswap_jmp. apply H3. ``` ``` apply set_mem_correct2. apply set_add_intro1. ``` ``` apply set_mem_correct1 with Fin.eq_dec. assumption. ``` ``` apply H6. ``` ``` Qed. ``` ``` ``` ``` Lemma remove_pc_safe_run : forall {n} (inp : input n) i pc v acc st', ``` ``` run_noswap inp (pc, set_add Fin.eq_dec i v, acc) st' -> ``` ``` exists st'', run_noswap inp (pc, v, acc) st''. ``` ``` Proof. ``` ``` intros n inp i pc v acc st' Hr. ``` ``` dependent induction Hr. ``` ``` - eexists. eapply run_noswap_ok. ``` ``` - eexists. eapply run_noswap_fail. ``` ``` apply set_mem_complete1 in H. ``` ``` apply set_mem_complete2. ``` ``` intros Hin. apply H. apply set_add_intro. right. apply Hin. ``` ``` - inversion H; subst; destruct (set_mem Fin.eq_dec pc' v) eqn:Hm. ``` ``` Admitted. ``` ``` ``` ``` Lemma add_pc_safe_run : forall {n} (inp : input n) i pc v acc st', ``` ``` run_noswap inp (pc, v, acc) st' -> ``` ``` exists st'', run_noswap inp (pc, (set_add Fin.eq_dec i v), acc) st''. ``` ``` Proof. ``` ``` intros n inp i pc v acc st' Hr. ``` ``` destruct (set_mem Fin.eq_dec i v) eqn:Hm. ``` ``` (* If i is already in the set, nothing changes. *) ``` ``` rewrite set_add_idempotent. ``` ``` exists st'. assumption. assumption. ``` ``` (* Otherwise, the behavior might have changed.. *) ``` ``` destruct (fin_big_or_small pc). ``` ``` - (* If we're done, we're done no matter what. *) ``` ``` eexists. rewrite H. eapply run_noswap_ok. ``` ``` - (* The PC points somewhere inside. We tried (and maybe failed) ``` ``` to execute and instruction. The challenging part ``` ``` is that adding i may change the outcome from 'fail' to 'ok' *) ``` ``` destruct H as [pc' Heq]. ``` ``` generalize dependent st'. ``` ``` induction v using (@set_induction (fin n) Fin.eq_dec); ``` ``` intros st' Hr. ``` ``` + (* Our set of valid states is nearly empty. One step, ``` ``` and it runs dry. *) ``` ``` simpl. destruct (Fin.eq_dec pc' i) eqn:Heq_dec. ``` ``` * (* The PC is the one allowed state. *) ``` ``` remember (nth inp pc') as h. destruct h. destruct o. ``` ``` { (* Addition. *) ``` ``` destruct (fin_big_or_small (FS pc')). ``` ``` - (* The additional step puts as at the end. *) ``` ``` eexists. eapply run_noswap_trans. ``` ``` + rewrite Heq. apply step_noswap_add. ``` ``` symmetry. apply Heqh. simpl. rewrite Heq_dec. reflexivity. ``` ``` + rewrite H. apply run_noswap_ok. ``` ``` - (* The additional step puts us somewhere else. *) ``` ``` destruct H as [f' H]. ``` ``` eexists. eapply run_noswap_trans. ``` ``` + rewrite Heq. apply step_noswap_add. ``` ``` symmetry. apply Heqh. simpl. rewrite Heq_dec. reflexivity. ``` ``` + rewrite H. apply run_noswap_fail. ``` ``` simpl. rewrite Heq_dec. reflexivity. } ``` ``` { (* No-op *) admit. } ``` ``` { (* Jump*) admit. } ``` ``` * (* The PC is not. We're done. *) ``` ``` eexists. rewrite Heq. eapply run_noswap_fail. ``` ``` simpl. rewrite Heq_dec. reflexivity. ``` ``` + destruct (set_mem Fin.eq_dec a v) eqn:Hm'. ``` ``` * unfold fin. rewrite (set_add_idempotent Fin.eq_dec a). ``` ``` ``` ``` ``` ``` { apply step_noswap_nop. ``` ``` - symmetry. apply Heqh. ``` ``` - simpl. rewrite Heq_dec. reflexivity. } ``` ``` ``` ``` (* ``` ``` dependent induction Hr; subst. ``` ``` + (* We can't be in the OK state, since we already covered ``` ``` that earlier. *) ``` ``` destruct n. inversion pc'. ``` ``` apply weaken_neq_to_fin in Heq as []. ``` ``` + apply weaken_one_inj in Heq as Hs. subst. ``` ``` destruct (Fin.eq_dec pc'0 i) eqn:Heq_dec. ``` ``` * admit. ``` ``` * eexists. eapply run_noswap_fail. ``` ``` assert (~set_In pc'0 v). ``` ``` { apply (set_mem_complete1 Fin.eq_dec). assumption. } ``` ``` assert (~set_In pc'0 (List.cons i List.nil)). ``` ``` { simpl. intros [Heq'|[]]. apply n0. auto. } ``` ``` assert (~set_In pc'0 (set_union Fin.eq_dec v (List.cons i List.nil))). ``` ``` { intros Hin. apply set_union_iff in Hin as [Hf|Hf]. ``` ``` - apply H0. apply Hf. ``` ``` - apply H1. apply Hf. } ``` ``` simpl in H2. apply set_mem_complete2. assumption. ``` ``` + apply (add_pc_safe_step _ _ i) in H as [st''' Hr']. ``` ``` eexists. eapply run_noswap_trans. ``` ``` apply Hr'. destruct st' as [[pc'' v''] acc'']. ``` ``` specialize (IHHr i pc'' v'' acc'').*) ``` ``` ``` ``` ``` ``` (* intros n inp i pc v. ``` ``` generalize dependent i. ``` ``` generalize dependent pc. ``` ``` induction v; intros pc i acc st Hr. ``` ``` - inversion Hr; subst. ``` ``` + eexists. apply run_noswap_ok. ``` ``` + destruct (Fin.eq_dec pc' i) eqn:Heq_dec. ``` ``` * admit. ``` ``` * eexists. apply run_noswap_fail. ``` ``` simpl. rewrite Heq_dec. reflexivity. ``` ``` + inversion H; subst; simpl in H7; inversion H7. ``` ``` - inversion Hr; subst. ``` ``` + eexists. apply run_noswap_ok. ``` ``` + destruct (Fin.eq_dec pc' i) eqn:Heq_dec. ``` ``` * admit. ``` ``` * eexists. apply run_noswap_fail. ``` ``` simpl. rewrite Heq_dec. simpl in H4. ``` ``` apply H4. ``` ``` + ``` ``` destruct (nth inp pc') as [op t]. *) ``` ``` ``` ``` Admitted. ``` ``` ``` ``` Theorem valid_input_terminates : forall n (inp : input n) st, ``` ``` valid_input inp -> exists st', run_noswap inp st st'. ``` ``` Proof. ``` ``` intros n inp st. ``` ``` destruct st as [[pc is] acc]. ``` ``` generalize dependent inp. ``` ``` generalize dependent pc. ``` ``` generalize dependent acc. ``` ``` induction is using (@set_induction (fin n) Fin.eq_dec); intros acc pc inp Hv; ``` ``` (* The PC may point past the end of the ``` ``` array, or it may not. *) ``` ``` destruct (fin_big_or_small pc); ``` ``` (* No matter what, if it's past the end ``` ``` of the array, we're done, *) ``` ``` try (eexists (pc, _, acc); rewrite H; apply run_noswap_ok). ``` ``` - (* It's not past the end of the array, ``` ``` and the 'allowed' list is empty. ``` ``` Evaluation fails. *) ``` ``` destruct H as [f' Heq]. ``` ``` exists (pc, Datatypes.nil, acc). ``` ``` rewrite Heq. apply run_noswap_fail. reflexivity. ``` ``` - (* We're not past the end of the array. However, ``` ``` adding a new valid index still guarantees ``` ``` evaluation terminates. *) ``` ``` specialize (IHis acc pc inp Hv) as [st' Hr]. ``` ``` apply add_pc_safe_run with st'. assumption. ``` ``` Qed. ``` ``` ``` ``` (* ``` ``` (* It's not past the end of the array, ``` ``` and we're in the inductive case on is. *) ``` ``` destruct H as [pc' Heq]. ``` ``` destruct (Fin.eq_dec pc' a) eqn:Heq_dec. ``` ``` + (* This PC is allowed. *) ``` ``` (* That must mean we have a non-empty list. *) ``` ``` remember (nth inp pc') as h. destruct h as [op t]. ``` ``` (* Unfortunately, we can't do eexists at the top ``` ``` level, since that will mean the final state ``` ``` has to be the same for every op. *) ``` ``` destruct op. ``` ``` (* Addition. *) ``` ``` { destruct (IHis (M.add acc t) (FS pc') inp Hv) as [st' Htrans]. ``` ``` eexists. eapply run_noswap_trans. ``` ``` rewrite Heq. apply step_noswap_add. ``` ``` - symmetry. apply Heqh. ``` ``` - simpl. rewrite Heq_dec. reflexivity. ``` ``` - simpl. rewrite Heq_dec. apply Htrans. } ``` ``` (* No-ops *) ``` ``` { destruct (IHis acc (FS pc') inp Hv) as [st' Htrans]. ``` ``` eexists. eapply run_noswap_trans. ``` ``` rewrite Heq. apply step_noswap_nop with t. ``` ``` - symmetry. apply Heqh. ``` ``` - simpl. rewrite Heq_dec. reflexivity. ``` ``` - simpl. rewrite Heq_dec. apply Htrans. } ``` ``` (* Jump. *) ``` ``` { (* A little more interesting. We need to know that the jump is valid. *) ``` ``` assert (Hv' : valid_inst (jmp, t) pc'). ``` ``` { specialize (Hv pc'). rewrite <- Heqh in Hv. assumption. } ``` ``` inversion Hv'. ``` ``` (* Now, proceed as usual. *) ``` ``` destruct (IHis acc f' inp Hv) as [st' Htrans]. ``` ``` eexists. eapply run_noswap_trans. ``` ``` rewrite Heq. apply step_noswap_jmp with t. ``` ``` - symmetry. apply Heqh. ``` ``` - simpl. rewrite Heq_dec. reflexivity. ``` ``` - apply H0. ``` ``` - simpl. rewrite Heq_dec. apply Htrans. } ``` ``` + (* The top PC is not allowed. *) ``` ``` specialize (IHis acc pc inp Hv) as [st' Hr]. ``` ``` apply add_pc_safe_run with st'. assumption. *) ``` ``` Qed. ``` ``` ``` ``` ``` ``` (* Stoppped here. *) ``` ``` Admitted. *) ``` ```End DayEight. ```