Advent-of-Code/AdventOfCode-2020
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Finish first proof for day 8.

Browse Source 
Apparently writing proof objects by hand is
easier than using tactics.
This commit is contained in:
Danila Fedorin 2020-12-12 22:49:52 -08:00
parent 7757fd2b49
commit 8ea03a4c51
1 changed files with 41 additions and 444 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

485
day8.v
View File

@ -5,6 +5,8 @@ Require Import Coq.Vectors.Fin.
Require Import Coq.Program.Equality.
Require Import Coq.Logic.Eqdep_dec.
Require Import Coq.Arith.Peano_dec.
Require Import Coq.Program.Wf.
Require Import Lia.
Module DayEight (Import M:Int).
(* We need to coerce natural numbers into integers to add them. *)
@ -177,9 +179,9 @@ Module DayEight (Import M:Int).
Theorem valid_input_progress : forall pc v acc,
(pc = nat_to_fin n /\ done inp (pc, v, acc)) \/
exists pcs, pc = weaken_one pcs /\
(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'))).
(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? *)
@ -197,450 +199,45 @@ Module DayEight (Import M:Int).
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.
Program Fixpoint valid_input_terminates (pc : fin (S n)) (v : set (fin n)) (acc : t) (Hnd : List.NoDup v)
{ measure (length v) }:
(exists pc', run_noswap inp (pc, v, acc) pc') :=
match valid_input_progress pc v acc with
| or_introl (conj Heq Hdone) =>
inhabited_sig_to_exists
(inhabits
(@exist (state n)
(fun x => run_noswap inp (pc, v, acc) x) (pc, v, acc) (run_noswap_ok _ _ Hdone)))
| or_intror (ex_intro _ pcs (conj Hw w)) =>
match w with
| or_introl (conj Hnin Hstuck) =>
inhabited_sig_to_exists
(inhabits
(@exist (state n)
(fun x => run_noswap inp (pc, v, acc) x) (pc, v, acc) (run_noswap_fail _ _ Hstuck)))
| or_intror (ex_intro _ pc' (ex_intro _ acc' (conj Hin Hst))) =>
match valid_input_terminates pc' (set_remove Fin.eq_dec pcs v) acc' (set_remove_nodup Fin.eq_dec pcs Hnd) with
| ex_intro _ pc'' Hrun =>
inhabited_sig_to_exists
(inhabits
(@exist (state n)
(fun x => run_noswap inp (pc, v, acc) x) pc''
(run_noswap_trans _ _ (pc', set_remove Fin.eq_dec pcs v, acc') _ Hst Hrun)))
end
end
end.
Obligation 1.
clear Heq_anonymous. clear valid_input_terminates. clear Hst.
induction v.
- inversion Hin.
- destruct (Fin.eq_dec pcs a) eqn:Heq_dec.
+ simpl. rewrite Heq_dec. lia.
+ inversion Hnd; subst.
inversion Hin. subst. exfalso. apply n0. auto.
specialize (IHv H2 H).
simpl. rewrite Heq_dec. simpl. lia.
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.