yadunut/nus
1
0
Fork 0
Code Issues Pull Requests Actions Projects Releases Wiki Activity

maybe good?

Browse Source
This commit is contained in:
Yadunand Prem
2024-04-28 15:58:30 +08:00
parent 1312e694c3
commit d2e87aec97
21 changed files with 3097 additions and 700 deletions
Download Patch File Download Diff File Expand all files Collapse all files

303
cs3234/labs/midterm_project.v
View File

@@ -956,13 +956,34 @@ Proof.
fold_unfold_tactic list_reverse.
Qed.
Theorem about_list_reverse_acc_and_list_append :
forall (V: Type)
(v : V)
(vs acc : list V),
list_reverse_acc V vs (list_append V acc (v :: nil)) =
list_append V (list_reverse_acc V vs acc) (v :: nil).
Proof.
intros V v vs.
induction vs as [ | v' vs' IHvs'].
- intro acc.
rewrite -> (fold_unfold_list_reverse_acc_nil V (list_append V acc (v :: nil))).
rewrite -> (fold_unfold_list_reverse_acc_nil V acc).
reflexivity.
- intro acc.
rewrite -> (fold_unfold_list_reverse_acc_cons V v' vs' (list_append V acc (v :: nil))).
rewrite -> (fold_unfold_list_reverse_acc_cons V v' vs' acc).
rewrite <- (IHvs' (v' :: acc)).
rewrite -> (fold_unfold_list_append_cons V v' acc).
reflexivity.
Qed.
Theorem list_reverse_alt_satisfies_the_specification_of_list_reverse :
specification_of_list_reverse list_reverse_alt.
Proof.
unfold specification_of_list_reverse.
intros append.
unfold specification_of_list_append.
intros [S_append_nil S_append_cons].
intro S_append.
split.
- intros V.
unfold list_reverse_alt.
@@ -970,59 +991,108 @@ Proof.
- intros V v vs.
unfold list_reverse_alt.
rewrite -> (fold_unfold_list_reverse_acc_cons V v vs nil).
induction vs as [ | v' vs' IHvs' ].
+ rewrite -> (fold_unfold_list_reverse_acc_nil V (v :: nil)).
rewrite -> (fold_unfold_list_reverse_acc_nil V nil).
rewrite -> (S_append_nil V (v :: nil)).
reflexivity.
+ rewrite -> (fold_unfold_list_reverse_acc_cons V v' vs' (v :: nil)).
rewrite -> (fold_unfold_list_reverse_acc_cons V v' vs' nil).
Search list_append.
Abort.
rewrite <- (fold_unfold_list_append_nil V (v :: nil)).
rewrite -> (about_list_reverse_acc_and_list_append V v vs nil).
(* FIXME: This feels pretty sketchy and I don't fully pass in arguments, so there might be some Coq magic here. *)
Check (there_is_at_most_one_list_append_function V append list_append S_append
list_append_satisfies_the_specification_of_list_append).
rewrite -> (there_is_at_most_one_list_append_function V append list_append S_append
list_append_satisfies_the_specification_of_list_append
(list_reverse_acc V vs nil) (list_append V nil (v :: nil))).
rewrite -> (nil_is_left_neutral_wrt_list_append V).
reflexivity.
Qed.
(* {END} *)
(* Theorem about_list_reverse_acc_and_list_append : *)
(* forall append : forall W : Type, list W -> list W -> list W, *)
(* specification_of_list_append append -> *)
(* forall (V: Type) *)
(* (acc acc' vs : list V), *)
(* list_reverse_acc V vs (append V acc acc') = append V (list_reverse_acc V vs acc) acc'. *)
(* Proof. *)
(* intros append [S_append_nil S_append_cons]. *)
(* intros V acc acc' vs. *)
(* revert acc' vs. *)
(* induction acc as [ | v acc'' IHacc'']. *)
(* - intros acc' vs. *)
(* rewrite -> (S_append_nil V acc'). *)
(* Check (fold_unfold_list_reverse_acc_nil). *)
(* {task_5_h_4} *)
Theorem there_is_at_most_one_list_reverse_function :
forall (V: Type)
(list_reverse_1 list_reverse_2 : forall V : Type, list V -> list V),
specification_of_list_reverse list_reverse_1 ->
specification_of_list_reverse list_reverse_2 ->
forall vs : list V,
list_reverse_1 V vs = list_reverse_2 V vs.
Proof.
intros V list_reverse_1 list_reverse_2.
intros S_list_reverse_1 S_list_reverse_2.
unfold specification_of_list_reverse in S_list_reverse_1.
assert (specification_of_list_append list_append) as S_list_append.
{ exact list_append_satisfies_the_specification_of_list_append. }
assert (S_list_reverse_1 := (S_list_reverse_1 list_append S_list_append)).
assert (S_list_reverse_2 := (S_list_reverse_2 list_append S_list_append)).
destruct S_list_reverse_1 as [S_list_reverse_1_nil S_list_reverse_1_cons].
destruct S_list_reverse_2 as [S_list_reverse_2_nil S_list_reverse_2_cons].
(* reverse vs (append acc acc') = append (reverse vs acc) acc' *)
(* reverse vs (a :: b :: nil) = [reverse vs (a :: nil)] (b :: nil) *)
(* reverse abc nil
= reverse bc [a, nil]
= reverse c [b, a, nil]
= reverse nil [c, b, a, nil]
*)
intro vs.
induction vs as [ | v' vs' IHvs' ].
- rewrite -> (S_list_reverse_2_nil V).
exact (S_list_reverse_1_nil V).
- rewrite -> (S_list_reverse_2_cons V v' vs').
rewrite -> (S_list_reverse_1_cons V v' vs').
rewrite -> IHvs'.
reflexivity.
Qed.
(* {END} *)
(* TODO The name of this isn't that great *)
(* {task_5_h_5} *)
Proposition list_reverse_and_list_reverse_alt_equiv :
forall (V : Type)
(vs : list V),
list_reverse V vs = list_reverse_alt V vs.
Proof.
intro V.
exact (there_is_at_most_one_list_reverse_function V list_reverse list_reverse_alt
list_reverse_satisfies_the_specification_of_list_reverse
list_reverse_alt_satisfies_the_specification_of_list_reverse).
Qed.
(* {END} *)
(* Lemma about_list_append : *)
(* forall append : forall W : list W -> list W -> list W, *)
(* specification_of_list_append append -> *)
(* (V : Type) *)
(* (v v' : V) *)
(* append V *)
(* TODO The name of this isn't that great *)
(* {task_5_h_6} *)
Proposition list_reverse_alt_and_list_append_commute_with_each_other :
forall (V : Type)
(v1s v2s : list V),
list_append V (list_reverse_alt V v2s) (list_reverse_alt V v1s) = list_reverse_alt V (list_append V v1s v2s).
Proof.
intros V v1s v2s.
rewrite <- (list_reverse_and_list_reverse_alt_equiv V v2s).
rewrite <- (list_reverse_and_list_reverse_alt_equiv V v1s).
rewrite <- (list_reverse_and_list_reverse_alt_equiv V (list_append V v1s v2s)).
exact (list_reverse_and_list_append_commute_with_each_other V v1s v2s).
Qed.
(* {END} *)
(* TODO The name of this isn't that great *)
(* {task_5_h_7} *)
Proposition list_reverse_alt_and_list_length_commute_with_each_other :
forall (V : Type)
(vs : list V),
list_length V (list_reverse_alt V vs) = list_length V vs.
Proof.
intros V vs.
rewrite <- (list_reverse_and_list_reverse_alt_equiv V vs).
exact (list_reverse_and_list_length_commute_with_each_other V vs).
Qed.
(* {END} *)
(* TODO The name of this isn't that great *)
(* {task_5_h_8} *)
Proposition list_reverse_alt_is_involutory :
forall (V : Type)
(vs : list V),
list_reverse_alt V (list_reverse_alt V vs) = vs.
Proof.
intros V vs.
rewrite <- (list_reverse_and_list_reverse_alt_equiv V vs).
rewrite <- (list_reverse_and_list_reverse_alt_equiv V (list_reverse V vs)).
exact (list_reverse_is_involutory V vs).
Qed.
(* Definition there_is_at_most_one_list_reverse_function : *)
(* forall (V : Type) *)
(* (f g : forall V : Type, list V -> list V), *)
(* specification_of_list_reverse f -> *)
(* specification_of_list_reverse g -> *)
(* forall vs : list V, *)
(* f V vs = g V vs. *)
(* Proof. *)
(* intros V. *)
(* intros f g S_f S_g. *)
(* intros vs. *)
(* ********** *)
@@ -1133,7 +1203,8 @@ Proof.
rewrite -> (fold_unfold_list_map_nil V V (fun v => v)).
reflexivity.
- intros V v vs.
rewrite -> (fold_unfold_list_map_cons V V (fun v => v) v vs).
unfold list_copy_as_list_map.
rewrite -> (fold_unfold_list_map_cons V V (fun a => a) v vs).
reflexivity.
Qed.
@@ -1152,7 +1223,7 @@ Proposition list_map_and_list_length_commute_with_each_other :
Proof.
intros V W f vs.
induction vs as [ | v' vs' IHvs' ].
- rewrite ->(fold_unfold_list_map_nil V W f).
- rewrite ->(fold_unfold_list_map_nil V W f).
rewrite -> (fold_unfold_list_length_nil V).
exact (fold_unfold_list_length_nil W).
- rewrite -> (fold_unfold_list_map_cons V W f v' vs').
@@ -1192,15 +1263,72 @@ Proof.
h. Do list_map and list_reverse commute with each other and if so how?
*)
Proposition list_map_and_list_reverse_commute_with_each_other :
forall (V W : Type)
(f : V -> W)
(vs : list V),
list_reverse W (list_map V W f vs) = list_map V W f (list_reverse V vs).
Proof.
intros V W f vs.
induction vs as [ | v vs' IHvs' ].
- rewrite -> (fold_unfold_list_map_nil V W f).
rewrite -> (fold_unfold_list_reverse_nil V).
rewrite -> (fold_unfold_list_reverse_nil W).
rewrite -> (fold_unfold_list_map_nil V W f).
reflexivity.
- rewrite -> (fold_unfold_list_map_cons V W f v vs').
rewrite -> (fold_unfold_list_reverse_cons W (f v) (list_map V W f vs')).
rewrite -> IHvs'.
rewrite -> (fold_unfold_list_reverse_cons V v vs').
rewrite <- (fold_unfold_list_map_nil V W f).
rewrite <- (fold_unfold_list_map_cons V W f v nil).
Check list_map_and_list_append_commute_with_each_other.
rewrite -> (list_map_and_list_append_commute_with_each_other V W f (list_reverse V vs') (v :: nil)).
reflexivity.
Qed.
(*
i. Do list_map and list_reverse_alt commute with each other and if so how?
*)
Proposition list_map_and_list_reverse_alt_commute_with_each_other :
forall (V W : Type)
(f : V -> W)
(vs : list V),
list_reverse_alt W (list_map V W f vs) = list_map V W f (list_reverse_alt V vs).
Proof.
intros V W f vs.
Check list_reverse_and_list_reverse_alt_equiv.
rewrite <- (list_reverse_and_list_reverse_alt_equiv W (list_map V W f vs)).
rewrite <- (list_reverse_and_list_reverse_alt_equiv V vs).
exact (list_map_and_list_reverse_commute_with_each_other V W f vs).
Qed.
(*
j. Define a unit-test function for the map function
and verify that your implementation satisfies it.
*)
Fixpoint evenp (n : nat): bool :=
match n with
| 0 => true
| S n' => match n' with
| 0 => false
| S n'' => evenp n''
end
end.
Definition test_list_map (candidate : forall V W : Type, (V -> W) -> list V -> list W) :=
(eqb_list nat Nat.eqb (candidate nat nat (fun v => v) nil) nil) &&
(eqb_list nat Nat.eqb (candidate nat nat (fun v => v) (1 :: 2:: 3 :: nil)) (1 :: 2 :: 3 :: nil)) &&
(eqb_list nat Nat.eqb (candidate nat nat (fun v => S v) (1 :: 2:: 3 :: nil)) (2 :: 3 :: 4 :: nil)) &&
(eqb_list bool Bool.eqb (candidate nat bool evenp (1 :: 2:: 3 :: nil)) (false :: true :: false :: nil)).
Compute test_list_map list_map.
(* ********** *)
(* A study of the polymorphic fold-right and fold-left functions: *)
@@ -1242,6 +1370,7 @@ Definition specification_of_list_fold_left (fold_left : forall V W : Type, W ->
a. Implement the fold-right function recursively.
*)
Fixpoint list_fold_right (V W : Type) (nil_case : W) (cons_case : V -> W -> W) (vs : list V) : W :=
match vs with
nil =>
@@ -1314,44 +1443,110 @@ Qed.
d. Prove that each of your implementations satisfies the corresponding specification.
*)
Theorem list_fold_left_satisfies_the_specification_of_fold_left :
specification_of_list_fold_left list_fold_left.
Proof.
unfold specification_of_list_fold_left.
split.
- exact fold_unfold_list_fold_left_nil.
- exact fold_unfold_list_fold_left_cons.
Qed.
Theorem list_fold_right_satisfies_the_specification_of_fold_right :
specification_of_list_fold_right list_fold_right.
Proof.
unfold specification_of_list_fold_right.
split.
- exact fold_unfold_list_fold_right_nil.
- exact fold_unfold_list_fold_right_cons.
Qed.
(*
e. Which function do foo and bar (defined just below) compute?
*)
(*
Definition foo (V : Type) (vs : list V) :=
list_fold_right V (list V) nil (fun v vs => v :: vs) vs.
*)
(*
Compute test_list_copy foo.
Definition bar (V : Type) (vs : list V) :=
list_fold_left V (list V) nil (fun v vs => v :: vs) vs.
*)
Compute test_list_reverse bar.
(*
f. Implement the length function either as an instance of list_fold_right or as an instance of list_fold_left, and justify your choice.
*)
Definition list_length_using_list_fold_left (V: Type) (vs : list V): nat :=
list_fold_left V nat 0 (fun _ length => S (length)) vs.
Compute test_list_length list_length_using_list_fold_left.
(*
g. Implement the copy function either as an instance of list_fold_right or as an instance of list_fold_left, and justify your choice.
*)
Definition list_copy_using_list_fold_right (V: Type) (vs : list V): (list V) :=
list_fold_right V (list V) nil (fun v acc => v :: acc) vs.
Compute test_list_copy list_copy_using_list_fold_right.
(*
h. Implement the append function either as an instance of list_fold_right or as an instance of list_fold_left, and justify your choice.
*)
Definition list_append_using_list_fold_right (V: Type) (v1s v2s : list V): (list V) :=
list_fold_right V (list V) v2s (fun v acc => v :: acc) v1s.
Compute test_list_append list_append_using_list_fold_right.
(*
i. Implement the reverse function either as an instance of list_fold_right or as an instance of list_fold_left, and justify your choice.
*)
Definition list_reverse_using_list_fold_left (V: Type) (vs : list V): (list V) :=
list_fold_left V (list V) nil (fun v acc => v :: acc) vs.
Compute test_list_reverse list_reverse_using_list_fold_left.
(*
j. Implement the map function either as an instance of list_fold_right or as an instance of list_fold_left, and justify your choice.
*)
Definition list_map_using_list_fold_right (V W: Type) (f : V -> W) (vs : list V): (list W) :=
list_fold_right V (list W) nil (fun v w => (f v) :: w) vs.
Compute test_list_map list_map_using_list_fold_right.
(*
k. Implement eqb_list either as an instance of list_fold_right or as an instance of list_fold_left, and justify your choice.
*)
(* FIXME: This feels very hacky, because of the match result with, but I have no idea how to consider if the first list finishes iteration,
then the result should be false without the match case outside of the fold function
*)
Definition eqb_list_using_list_fold_right (V : Type) (eqb_V: V -> V -> bool) (v1s v2s : list V) :=
let result := list_fold_left V
(bool * list V)
(true, v2s)
(fun v1 acc =>
match acc with
| (false, v2::v2s') => (false, v2s')
| (false, nil) => (false, nil)
| (true, v2::v2s') => (eqb_V v1 v2, v2s')
| (true, nil) => (false, nil)
end)
v1s in
match result with
| (false, _) => false
| (true, nil) => true
| _ => false
end.
(* TODO Write testcases *)
(*
l. Implement list_fold_right as an instance of list_fold_left, using list_reverse.
*)

20
cs3234/labs/term-project.v
View File

@@ -724,6 +724,26 @@ Definition specification_of_run (run : target_program -> expressible_value) :=
fetch_decode_execute_loop bcis nil = KO s ->
run (Target_program bcis) = Expressible_msg s).
Theorem there_is_at_most_one_run_function :
forall (f g : target_program -> expressible_value),
specification_of_run f ->
specification_of_run g ->
forall (t: target_program),
f t = g t.
Proof.
intros f g.
unfold specification_of_run.
intros S_f S_g [bcis].
case (fetch_decode_execute_loop bcis nil) as [ds | s] eqn:H_fdel.
- destruct (S_f fetch_decode_execute_loop fetch_decode_execute_loop_satifies_the_specification) as [S_f_nil _].
destruct (S_g fetch_decode_execute_loop fetch_decode_execute_loop_satifies_the_specification) as [S_g_nil _].
case ds as [ | n ds' ] eqn:H_ds.
+ rewrite -> (S_g_nil bcis H_fdel).
exact (S_f_nil bcis H_fdel).
+ Check (S_f_nil bcis).
(* Task 4:
a. time permitting, prove that the definition above specifies at most one function;
b. implement this function; and