From ab4eab4f51ce59fd29308c693c2bb77c73575de3 Mon Sep 17 00:00:00 2001
From: Felipe Lisboa <lisboafelipe5@gmail.com>
Date: Thu, 8 Feb 2024 15:38:38 +0100
Subject: [PATCH] Succesfull merge between CavaDRAM most updated version and
CoqDRAM
---
framework/CavaDRAM/CavaCommonInstances.v | 25 +-
framework/CavaDRAM/CavaFIFOProperties.v | 1654 +++++++++++++++++
framework/CavaDRAM/CavaFIFOREF.v | 131 +-
framework/CavaDRAM/CavaReqQueue.v | 106 +-
framework/CavaDRAM/CavaReqQueueProperties.v | 424 +++++
framework/CavaDRAM/CavaSMExtraction.v | 6 +-
framework/CavaDRAM/CavaSubtractor.v | 124 +-
framework/CavaDRAM/CavaSubtractorProperties.v | 2 +-
framework/CavaDRAM/CavaSystem.v | 21 +-
framework/CavaDRAM/CavaTDMREF.v | 196 +-
framework/CavaDRAM/CavaTDMREFProperties.v | 111 ++
framework/CavaDRAM/Lib/CavaCounter.v | 2 +-
framework/CavaDRAM/Lib/CavaFIFO.v | 2 +-
.../CavaDRAM/Lib/CavaFIFOREFProperties.v | 1630 ++++++++++++++++
.../CavaDRAM/Lib/CavaFIFOREFProperties2.v | 311 ++++
framework/CavaDRAM/Lib/CavaSM.v | 2 +-
framework/CavaDRAM/Lib/CavaSMProperties2.v | 6 +-
framework/CavaDRAM/Lib/CavaSMbackup.v | 2 +-
framework/CavaDRAM/Lib/CavaTactics.v | 8 +-
framework/CavaDRAM/Memory.v | 293 +++
framework/CavaDRAM/README_extraction.md | 9 +
framework/CavaDRAM/Step.v | 97 +
framework/CavaDRAM/Util.v | 154 ++
framework/CavaDRAM/UtilSM.v | 326 ++++
framework/CavaDRAM/_CoqProject | 15 +-
framework/CavaDRAM/backup.v | 1256 +++++++++++++
26 files changed, 6711 insertions(+), 202 deletions(-)
create mode 100644 framework/CavaDRAM/CavaFIFOProperties.v
create mode 100644 framework/CavaDRAM/CavaReqQueueProperties.v
create mode 100644 framework/CavaDRAM/CavaTDMREFProperties.v
create mode 100644 framework/CavaDRAM/Lib/CavaFIFOREFProperties.v
create mode 100644 framework/CavaDRAM/Lib/CavaFIFOREFProperties2.v
create mode 100644 framework/CavaDRAM/Memory.v
create mode 100644 framework/CavaDRAM/README_extraction.md
create mode 100644 framework/CavaDRAM/Step.v
create mode 100644 framework/CavaDRAM/Util.v
create mode 100644 framework/CavaDRAM/UtilSM.v
create mode 100644 framework/CavaDRAM/backup.v
diff --git a/framework/CavaDRAM/CavaCommonInstances.v b/framework/CavaDRAM/CavaCommonInstances.v
index 1fc0a28..a150dfc 100644
--- a/framework/CavaDRAM/CavaCommonInstances.v
+++ b/framework/CavaDRAM/CavaCommonInstances.v
@@ -1,19 +1,30 @@
+Set Warnings "-notation-overridden,-parsing".
From CavaDRAM Require Import CavaSystem.
-From DRAM Require Import System.
+From CoqDRAM Require Import System.
From Coq Require Program.
+From mathcomp Require Import fintype ssrZ zify ring.
Section CommonInstances.
Program Instance CAVA_SYS : CavaSystem := {
DRAM_CMD_WIDTH := 5;
- FE_ADDR_WIDTH := 32;
+ (* FE_ADDR_WIDTH := 32 *)
+ ROW_ADDR_WIDTH := 17;
+ COL_ADDR_WIDTH := 11;
+ BANK_ADDR_WIDTH := 4;
FE_CMD_WIDTH := 1;
- FE_ID_WIDTH := 16;
- QUEUE_MAX_SIZE := 32;
+ (* FE_ID_WIDTH := 16; *)
+ QUEUE_MAX_SIZE := 256;
}.
-
+ Next Obligation.
+ apply PeanoNat.Nat.lt_0_succ.
+ Qed.
+ Next Obligation.
+ lia.
+ Qed.
+
Program Instance SYS_CFG : System_configuration := {
- BANKGROUPS := 4;
+ BANKGROUPS := 4;
BANKS := 2;
T_BURST := 4; (* 4*)
T_WL := 5; (* 5*)
@@ -31,7 +42,7 @@ Section CommonInstances.
T_WTR_l := 6; (*6*)
T_CCD_s := 4; (*4*)
T_CCD_l := 5; (*5*)
- T_REFI := 2880; (*orig: 2880, 7.8 us*)
+ T_REFI := 2054; (*orig: 2880, 7.8 us*)
T_RFC := 44; (* orig: 44, 1Gb 110 ns *)
}.
diff --git a/framework/CavaDRAM/CavaFIFOProperties.v b/framework/CavaDRAM/CavaFIFOProperties.v
new file mode 100644
index 0000000..3ab6753
--- /dev/null
+++ b/framework/CavaDRAM/CavaFIFOProperties.v
@@ -0,0 +1,1654 @@
+Set Printing Projections.
+Set Warnings "-notation-overridden,-parsing".
+
+From CavaDRAM Require Import CavaFIFOREF CavaReqQueue CavaReqQueueProperties
+CavaCommonInstances CavaSubtractor Step CavaSystem Memory Util UtilSM.
+From CoqDRAM Require Import FIFO.
+From Coq Require Import Program BinaryString HexString NArith.
+From Cava Require Import Cava CavaProperties Util.Vector Util.Tactics.
+From mathcomp Require Import fintype ssrZ zify ring.
+
+Section CavaFIFOProperties.
+
+ Context {signal : SignalType -> Type} {semantics : Cava signal}.
+ (* From Cava *)
+ Existing Instance CombinationalSemantics.
+ (* From CavaDRAM*)
+ Context {CAVA_SYS : CavaSystem}.
+ (* From CoqDRAM *)
+ Existing Instance REQESTOR_CFG.
+ Context {SYS_CFG : System_configuration}.
+ Context {FIFO_CFG : FIFO_configuration}.
+ Context {HAF : HW_Arrival_function_t}.
+ Existing Instance ARBITER_CFG.
+ Existing Instance FIFO_implementation.
+
+ Import Memory.Properties BvectorNotations.
+ Open Scope Bvector_scope.
+
+ Definition mem_cells_ :=
+ mem_cells (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem.
+
+ Lemma nth_cells_read {T W I} (ad : Bvector W) c_req def
+ (c : circuit_state (mem_cells T W (2 ^ W) I)) :
+ nth_default def (N.to_nat (Bv2N ad)) (Cells_read true (N.to_nat (Bv2N ad)) c_req c) = c_req.
+ Admitted.
+
+ Lemma nth_cells_read_ {T W I N} (ad : Bvector (Nat.log2 N)) c_req def
+ (c : circuit_state (mem_cells T W N I)) : N > 0 ->
+ nth_default def (N.to_nat (Bv2N ad)) (Cells_read true (N.to_nat (Bv2N ad)) c_req c) = c_req.
+ Proof.
+ intros Hpos; rewrite nth_default_to_list.
+ induction N; intros; [ discriminate | ].
+ rewrite leq_eqVlt in Hpos; move: Hpos => /orP [/eqP Heq | Hpos].
+ { assert (N = 0); [ lia | ]; clear IHN Heq; subst N.
+ revert ad; rewrite Nat.log2_1; intros.
+ apply Vector.case0 with (v := ad).
+ simpl in c; destruct_products.
+ rewrite /Cells_read //= andb_true_r.
+ }
+ assert (0 < N); [ lia | ]; clear Hpos.
+ simpl in c; destruct_products; rewrite //= andb_true_r.
+ specialize (Nat.log2_succ_or N) as Hor; destruct Hor as [Hor | Hor].
+ { revert ad; rewrite Hor; intros.
+ destruct (Nat.eqb (N.to_nat (Bv2N ad)) N) eqn:HH; set memvec := Cells_read true _ _ _.
+ { assert (N.to_nat (Bv2N ad) = N) as H0; [ lia | ]; clear HH;
+ rewrite H0.
+ specialize (@length_to_list_shiftin (combType T) N memvec c_req) as HH.
+ assert (N = (Datatypes.length (Vector.to_list (Vector.shiftin c_req memvec))) - 1)%coq_nat; [ lia | ].
+ apply nth_last with (d := def) in H1; rewrite H1.
+ by rewrite last_shiftin. }
+ { unfold memvec.
+ specialize (IHN (VectorDef.tl ad) c0); apply IHN in H as IH; clear IHN.
+ rewrite (Vector.eta ad) Bv2N_cons.
+ destruct (Vector.hd ad).
+ { rewrite N2Nat.inj_succ_double //= !Nat.add_0_r.
+ rewrite -nth_tl.
+ set adtl := N.to_nat (Bv2N (VectorDef.tl ad)).
+ fold adtl in IH.
+ admit. }
+ { admit. }
+ Admitted.
+
+ Lemma memcell_nch (c: circuit_state mem_cells_) (wra rda : Bvector ADDR_WIDTH) c_req def:
+ wra <> rda ->
+ nth_default def (N.to_nat (Bv2N rda)) (Cells_data c) =
+ nth_default def (N.to_nat (Bv2N rda)) (Cells_read true (N.to_nat (Bv2N wra)) c_req c).
+ Admitted.
+
+ (* ----------------------------------------------------------------------- *)
+ (* Getters and state signals manipulation -------------------------------- *)
+
+ Definition State_t := circuit_state FIFOSM_.
+
+ Definition get_fields (s : State_t) :=
+ let '(_,(_,(_,(_,(_,(_,(_,_,_,mem,_,_,_,_,rda),wra)),_,(_,(_,cr)),_,_,_,_,_,cref),cnt),st)) := s
+ in (mem,rda,wra,cr,cref,cnt,st).
+
+ Definition get_st (s : State_t) :=
+ let '(_,_,_,_,_,_,st) := get_fields s in st.
+
+ Definition get_cnt (s : State_t) :=
+ let '(_,_,_,_,_,cnt,_) := get_fields s in cnt.
+
+ Definition get_cref (s : State_t) :=
+ let '(_,_,_,_,cref,_,_) := get_fields s in cref.
+
+ Definition get_cr (s : State_t) :=
+ let '(_,_,_,cr,_,_,_) := get_fields s in cr.
+
+ Definition get_wra (s : State_t) :=
+ let '(_,_,wra,_,_,_,_) := get_fields s in wra.
+
+ Definition get_rda (s : State_t) :=
+ let '(_,rda,_,_,_,_,_) := get_fields s in rda.
+
+ Definition get_mem (s : State_t) : circuit_state memqueue' :=
+ let '(mem,_,_,_,_,_,_) := get_fields s in mem.
+
+ Definition get_reqqueue (s : State_t) : circuit_state RequestQueue' :=
+ let '(_,(_,(_,(_,cs_requeue,_,_,_,_,_,_,_,_),_),_)) := s in cs_requeue.
+
+ Create HintDb get_state.
+ Hint Unfold get_fields get_st get_cnt get_cref get_reqqueue get_addr_RequestQueue get_mem
+ get_memcells_RequestQueue get_mem_RequestQueue get_memcells get_cr : get_state.
+
+ (* --------------------------Bounding the counter ------------------- *)
+ Lemma cnt_bounded (cnt : Bvector COUNTER_WIDTH) :
+ N.to_nat (Bv2N cnt) < WAIT.
+ Proof.
+ specialize @Bv2N_upper_bound_nat with (bv := cnt) as H.
+ by rewrite /COUNTER_WIDTH WAIT_PW_2 in H.
+ Qed.
+
+ Definition Bv2cnt (cnt : Bvector COUNTER_WIDTH) : Counter_t :=
+ Ordinal (cnt_bounded cnt).
+
+ Definition cnt2Bv (cnt : Counter_t) :=
+ N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)).
+
+ (* -------------------------- cref counter -------------------------- *)
+ Definition cref2Bv (cref : Counter_ref_t) :=
+ N2Bv_sized COUNTER_REF_WIDTH (N.of_nat (nat_of_ord cref)).
+
+ Lemma cref_bound (c : Counter_ref_t) :
+ c < 2 ^ COUNTER_REF_WIDTH.
+ Proof.
+ unfold COUNTER_REF_WIDTH.
+ destruct (_ == PREA_date + (WAIT - 1)) eqn:HPW2; destruct c.
+ { simpl in *; move: HPW2 => /eqP HPW2; rewrite HPW2; lia. }
+ { specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as h.
+ specialize WAIT_pos as Hwpos; assert ((0 < PREA_date + (WAIT - 1))%coq_nat) as H0; [ lia | ].
+ apply h in H0; destruct H0 as [_ H1]; move: H1 => /ltP H1.
+ set aux := 2 ^ (Nat.log2 (PREA_date + (WAIT - 1))).+1; simpl; unfold aux; clear aux; lia.
+ }
+ Qed.
+
+ Lemma prea_date_bound :
+ PREA_date -1 < 2 ^ COUNTER_REF_WIDTH.
+ Proof.
+ unfold COUNTER_REF_WIDTH.
+ destruct (_ == PREA_date + (WAIT - 1)) eqn:HPW2.
+ { simpl in *; move: HPW2 => /eqP HPW2; rewrite HPW2; specialize WAIT_gt_one; lia. }
+ { specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as h.
+ assert ((0 < PREA_date + (WAIT - 1))%coq_nat) as H0;
+ specialize WAIT_gt_one as Hwt1; [ lia | ]; clear Hwt1.
+ apply h in H0; destruct H0 as [H0 H1]; lia.
+ }
+ Qed.
+
+ Lemma wait_bound :
+ WAIT - 1 < 2 ^ COUNTER_REF_WIDTH.
+ Proof.
+ unfold COUNTER_REF_WIDTH.
+ destruct (_ == PREA_date + (WAIT - 1)) eqn:HPW2.
+ { simpl in *; move: HPW2 => /eqP HPW2; rewrite HPW2. specialize PREA_date_pos; lia. }
+ { specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as h.
+ assert ((0 < PREA_date + (WAIT - 1))%coq_nat) as H0;
+ specialize WAIT_gt_one as Hwt1; [ lia | ]; clear Hwt1.
+ apply h in H0; destruct H0 as [H0 H1]; lia.
+ }
+ Qed.
+
+ Lemma cref_preadate_false (c : Counter_ref_t) :
+ (cref2Bv c =? CNT_REF_PREA) = false <->
+ (nat_of_ord c == PREA_date - 1) = false.
+ Proof.
+ split. {
+ unfold cref2Bv, CNT_REF_PREA; intros.
+ apply BVEq_iff_neq in H; rewrite bitvec_literal_correct in H.
+ apply N2Bv_sized_neq_if in H.
+ apply of_nat_neq in H.
+ by apply /eqP. }
+ { intros.
+ apply BVEq_iff_neq.
+ rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct.
+ apply N2Bv_sized_neq_iff; [ | | move: H => /eqP H; by rewrite Nat2N.inj_iff ];
+ apply /leP; apply N.size_nat_le_nat; apply /leP;
+ [ apply cref_bound | apply prea_date_bound ]. }
+ Qed.
+
+ Lemma cref_preadate_true (c : Counter_ref_t) :
+ (cref2Bv c =? CNT_REF_PREA) = true <->
+ (nat_of_ord c == PREA_date - 1) = true.
+ Proof.
+ split.
+ { unfold cref2Bv, CNT_REF_PREA; intros.
+ apply BVEq_iff_eq in H; rewrite bitvec_literal_correct in H.
+ apply N2Bv_sized_eq_iff in H;
+ [ apply Nat2N.inj in H; rewrite H; by apply /eqP | | ];
+ apply N.size_nat_le_nat; apply /leP;
+ [ apply cref_bound | apply prea_date_bound ].
+ }
+ { intros Href_prea; move: Href_prea => /eqP Href_prea; apply BVEq_iff_eq.
+ rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct; f_equal.
+ by rewrite Href_prea.
+ }
+ Qed.
+
+ Lemma CrefPREA_lt_CNT_REF_PREA:
+ CrefPREA_lt CNT_REF_PREA = false.
+ Proof.
+ cbv [CrefPREA_lt]; simpl_ident.
+ unfold greaterThanOrEqual; simpl_ident; unfold greaterThanOrEqualBool.
+ apply /negbF.
+ rewrite {1}/CNT_REF_PREA; rewrite !bitvec_literal_correct.
+ apply /N.leb_spec0; rewrite /CNT_REF_PREA /CNT_REF_WAIT !bitvec_literal_correct.
+ rewrite !Bv2N_N2Bv_sized. { apply N.le_add_r. }
+ all: apply to_nat_lt_pow; try rewrite -Nat2N.inj_add; rewrite Nat2N.id.
+ 2 : {
+ unfold COUNTER_REF_WIDTH; destruct (_ == PREA_date + (WAIT - 1)) eqn:Hpw2.
+ { move: Hpw2 => /eqP Hpw2; rewrite Hpw2;
+ specialize WAIT_gt_one; specialize PREA_date_gt_one; lia. }
+ { specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as h.
+ specialize WAIT_gt_one as Hwpos; assert ((0 < PREA_date + (WAIT - 1))%coq_nat) as H0; [ lia | ].
+ apply h in H0; destruct H0 as [H0 H1]; lia.
+ }
+ }
+ all: try (apply wait_bound || apply prea_date_bound).
+ Qed.
+
+ Lemma CrefPREA_lt_CNT_REF_WAIT cref:
+ (cref2Bv cref =? CNT_REF_PREA) = false -> (cref + WAIT < PREA_date) = true ->
+ CrefPREA_lt (cref2Bv cref) = true.
+ Proof.
+ intros Href_prea Href_service.
+ rewrite /CrefPREA_lt; simpl_ident; rewrite /greaterThanOrEqual; simpl_ident.
+ rewrite /greaterThanOrEqualBool /CNT_REF_WAIT /CNT_REF_PREA !bitvec_literal_correct !Bv2N_N2Bv_sized.
+ { destruct (~~ _) eqn:Hbug; [ done | ].
+ apply negbFE in Hbug; move: Hbug => /N.leb_spec0 Hbug.
+ assert (cref + (WAIT - 1) < (PREA_date - 1)).
+ { rewrite addnBA; [ | exact WAIT_pos].
+ rewrite subn1 -ltnS prednK; [ | by rewrite addn_gt0 WAIT_pos orb_true_r ].
+ rewrite subn1 prednK; [ | exact PREA_date_pos].
+ by rewrite Href_service.
+ }
+ move: H => /ltP H; apply N_lt_inj in H.
+ contradict Hbug; apply N.nle_gt; by rewrite -Nat2N.inj_add.
+ }
+ all: apply to_nat_lt_pow; try rewrite -Nat2N.inj_add; rewrite Nat2N.id.
+ all: try (apply cref_bound || apply wait_bound || apply prea_date_bound).
+ { unfold COUNTER_REF_WIDTH.
+ destruct (_ == PREA_date + (WAIT - 1)) eqn:Heq.
+ { move: Heq => /eqP Heq; rewrite Heq.
+ destruct cref; simpl in *; lia. }
+ { destruct cref.
+ set aux := 2 ^ (Nat.log2 (PREA_date + (WAIT - 1))).+1; simpl.
+ assert ((m + (WAIT - 1))%coq_nat < PREA_date + (WAIT - 1)); [ lia | ].
+ specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as HH; lia.
+ }
+ }
+ Qed.
+
+ Lemma CrefPREA_lt_CNT_REF_WAIT_F (c1 : Counter_ref_t) :
+ (c1 + WAIT < PREA_date) = false ->
+ CrefPREA_lt (cref2Bv c1) = false.
+ Proof.
+ intros;
+ rewrite /CrefPREA_lt; simpl_ident; rewrite /greaterThanOrEqual; simpl_ident.
+ rewrite /greaterThanOrEqualBool /CNT_REF_WAIT /CNT_REF_PREA !bitvec_literal_correct !Bv2N_N2Bv_sized.
+ { apply negb_false_iff; apply /N.leb_spec0; lia. }
+ all: apply to_nat_lt_pow; try rewrite -Nat2N.inj_add; rewrite Nat2N.id.
+ all: try (apply cref_bound || apply wait_bound || apply prea_date_bound).
+ all: try (apply cref_bound || apply wait_bound || apply prea_date_bound).
+ { unfold COUNTER_REF_WIDTH.
+ destruct (_ == PREA_date + (WAIT - 1)) eqn:Heq.
+ { move: Heq => /eqP Heq; rewrite Heq.
+ destruct c1; simpl in *; lia. }
+ { destruct c1.
+ set aux := 2 ^ (Nat.log2 (PREA_date + (WAIT - 1))).+1; simpl.
+ assert ((m + (WAIT - 1))%coq_nat < PREA_date + (WAIT - 1)); [ lia | ].
+ specialize (Nat.log2_spec (PREA_date + (WAIT - 1))) as HH; lia.
+ }
+ }
+ Qed.
+
+ (* -------------------------- Predicates -------------------------------- *)
+ Program Definition EqReq (r : Request_t) (r' : Bvector REQUEST_WIDTH) : bool.
+ Admitted.
+
+ Lemma EqReqNil : EqReq nullreq REQUEST_NIL = true.
+ Admitted.
+
+ Hypothesis HaltIfFull : forall t c,
+ let wra := get_wra c in
+ let rda := get_rda c in
+ if (HW_Arrival_at t != []) then ~~ fullQueue wra rda else true.
+
+ Definition EqCmd (f_cmd : Command_kind_t) (c_cmd : Bvector DRAM_CMD_WIDTH) : bool :=
+ match f_cmd with
+ | ACT => (c_cmd =? ACT_VEC)
+ | PRE => (c_cmd =? PRE_VEC)
+ | PREA => (c_cmd =? PREA_VEC)
+ | CRD => (c_cmd =? RD_VEC)
+ | CWR => (c_cmd =? WR_VEC)
+ | REF => (c_cmd =? REF_VEC)
+ | NOP => (c_cmd =? NOP_VEC)
+ end.
+
+ Fixpoint EqQueue (P : Requests_t) (wra rda : Bvector ADDR_WIDTH) :=
+ match P with
+ | [::] => (wra =? rda)
+ | x :: x0 => negb (wra =? rda) && (EqQueue x0 wra (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1)))
+ end.
+
+ Lemma EqQueue_diff_adr r0 r1 wra rda:
+ EqQueue (r0 :: r1) wra rda -> wra <> rda.
+ Proof.
+ simpl; intros; move: H => /andP [Hd H];
+ by move: Hd => /negPf Hd; apply BVEq_iff_neq in Hd.
+ Qed.
+
+ (* ----------------------------------------- *)
+ Lemma leN_leqn a b:
+ leq (S (addn (nat_of_bin a) 1)) (nat_of_bin b) -> N.lt (N.add a 1) b.
+ Proof. lia. Qed.
+
+ Lemma ltN_ltn a b:
+ leq (S (nat_of_bin a)) (nat_of_bin b) <-> N.lt a b.
+ Proof. lia. Qed.
+
+ Lemma succ_double_inj_neq a b:
+ a <> b -> N.succ_double a <> N.succ_double b.
+ Proof.
+ intros; rewrite !N.succ_double_spec; lia.
+ Qed.
+
+ Lemma succ_double_double_inj_neq a b:
+ a <> b -> N.succ_double a <> N.double b.
+ Proof.
+ intros; rewrite N.succ_double_spec N.double_spec; lia.
+ Qed.
+
+ Lemma neq_nat_of_bin (a b : N) :
+ not (@eq N a b) <->
+ not (@eq nat (nat_of_bin a) (nat_of_bin b)).
+ Proof. lia. Qed.
+
+ Lemma cons_neq_BV {n} (a : bool) (x y: Bvector n) :
+ ((a :: x)%vector) <> ((a :: y) %vector) -> x <> y.
+ Admitted.
+
+ Lemma Bv2N_neq_inj {W} (a b : Bvector W):
+ a <> b -> Bv2N a <> Bv2N b.
+ Proof.
+ intros; induction W; [ admit | ].
+ rewrite (Vector.eta a) (Vector.eta b); simpl;
+ destruct (Vector.hd a) eqn:Ha, (Vector.hd b) eqn:Hb;
+ specialize (IHW (VectorDef.tl a) (VectorDef.tl b)).
+ { assert ((VectorDef.tl a) <> (VectorDef.tl b)) as H0.
+ { rewrite (Vector.eta a) (Vector.eta b) in H; rewrite Ha Hb in H.
+ by apply cons_neq_BV in H. }
+ apply IHW in H0; by apply succ_double_inj_neq. }
+ all: admit.
+ Admitted.
+
+ (* Use in EqQueue_aux *)
+ Lemma Bvector_neq_N2Bv_sized_p1_neq {W} (a b : Bvector W) :
+ W > 0 -> a <> b ->
+ N2Bv_sized W (Bv2N a + 1) <> N2Bv_sized W (Bv2N b + 1).
+ Proof.
+ intros.
+ specialize (@Bv2N_upper_bound_nat W b) as Hub_b.
+ specialize (@Bv2N_upper_bound_nat W a) as Hub_a.
+ specialize (N2Bv_sized_neq_iff W (Bv2N a) (Bv2N b)) as Hneq.
+ apply Bv2N_neq_inj in H0; apply Hneq in H0; try (apply /leP; apply N.size_nat_le);
+ [ | by apply to_nat_lt_pow in Hub_a | by apply to_nat_lt_pow in Hub_b]; clear Hneq.
+ rewrite !N.add_1_r.
+ (* apply N2Bv_sized_neq_iff. *)
+ specialize (N2Bv_sized_neq_succ W (Bv2N a)) as Hsucc_a.
+ specialize (N2Bv_sized_neq_succ W (Bv2N b)) as Hsucc_b.
+ apply Hsucc_a in H as Ha'; clear Hsucc_a.
+ apply Hsucc_b in H as Hb'; clear Hsucc_b.
+ Admitted.
+
+ (* Use in EqQueue_aux *)
+ Lemma notfull_rd (wr rd : Bvector ADDR_WIDTH) :
+ let rdp1 := N2Bv_sized ADDR_WIDTH (Bv2N rd + 1) in
+ wr <> rd -> wr <> rdp1 -> ~~ fullQueue wr rd ->
+ ~~ fullQueue wr rdp1.
+ Proof.
+ intros rdp1 Hdif1 Hdif2 HF; unfold fullQueue in HF.
+ destruct (leq _ _) eqn:Hleq.
+ { rewrite leq_eqVlt in Hleq; move: Hleq => /orP [/eqP Heq | Hleq].
+ { admit. (* impossible *)}
+ unfold fullQueue.
+ destruct (Bv2N rdp1 <= _) eqn:Hleq2.
+ { apply /negPf; apply Nat.eqb_neq.
+ specialize (N.lt_neq (Bv2N wr - Bv2N rdp1) (N.of_nat QUEUE_MAX_SIZE - 1)) as H.
+ apply neq_nat_of_bin; apply H; clear H.
+ move: HF => /negPf HF; apply Nat.eqb_neq in HF.
+ apply neq_nat_of_bin in HF.
+ apply (N.lt_gt_cases (Bv2N wr - Bv2N rd) (N.of_nat QUEUE_MAX_SIZE - 1)) in HF as HF';
+ destruct HF' as [H0 | H1].
+ 2: admit. (* Impossible, Bv2N wr - Bv2N rd cannot be bigger than QMS *)
+ apply (N.lt_trans (Bv2N wr - Bv2N rdp1) (Bv2N wr - Bv2N rd) (N.of_nat QUEUE_MAX_SIZE - 1));
+ [ | exact H0 ].
+ assert (N.lt (Bv2N rd) (Bv2N rdp1)); [ admit | ].
+ lia.
+ }
+ { admit. }
+ }
+ { admit. }
+ Admitted.
+
+ (* Use in EqQueue_aux *)
+ Lemma notfull_adrs (wr rd : Bvector ADDR_WIDTH) :
+ let rdp1 := N2Bv_sized ADDR_WIDTH (Bv2N rd + 1) in
+ let wrp1 := N2Bv_sized ADDR_WIDTH (Bv2N wr + 1) in
+ wr <> rd -> ~~ fullQueue wr rd ->
+ wrp1 <> rd.
+ Proof.
+ intros rdp1 wrp1 Hdif NF; unfold fullQueue in NF.
+ destruct (leq _ _) eqn:Hleq.
+ { move: NF => /negPf NF; apply Nat.eqb_neq in NF.
+ rewrite leq_eqVlt in Hleq; move: Hleq => /orP [/eqP Hbug | Hltn].
+ { admit. (* Impossible *)}
+ apply neq_nat_of_bin in NF.
+ apply (N.lt_gt_cases (Bv2N wr - Bv2N rd) (N.of_nat QUEUE_MAX_SIZE - 1)) in NF as NF';
+ destruct NF' as [NF'| _].
+ 2: admit. (* Impossible *)
+ unfold wrp1.
+ specialize (N2Bv_sized_Bv2N ADDR_WIDTH rd) as HH; rewrite -HH; clear HH.
+ apply N2Bv_sized_neq_iff;
+ admit.
+ }
+ { admit. }
+ Admitted.
+
+ Lemma EqQueue_aux wra rda r0 r1 r:
+ ~~ fullQueue wra rda -> wra <> rda ->
+ EqQueue (r0 :: r1)%SEQ wra rda ->
+ EqQueue ((r0 :: r1)%SEQ ++ [r])%SEQ (N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) rda.
+ Proof.
+ intros NFULL Hadr HQ; rewrite //=.
+ simpl in HQ; move: HQ => /andP [_ HQ].
+ revert HQ Hadr NFULL; generalize wra rda; induction r1; intros; simpl in HQ.
+ { apply /andP; split.
+ { unfold fullQueue in NFULL.
+ move: NFULL; apply contraPN; intros; apply /negP; rewrite negb_involutive.
+ specialize ADDR_WIDTH_pos as Hawp; move: Hawp => /ltP Hawp.
+ destruct (Bv2N rda0 <= _) eqn:Hleq.
+ { apply BVEq_iff_eq in HQ as HQ'; rewrite HQ' in H; clear HQ'.
+ apply Bvector_wrap in H; [ | apply /ltP; exact ADDR_WIDTH_pos ].
+ apply log2_eq1_pw2 in H as H2 ; [ | by rewrite QUEUE_MAX_SIZE_PW2 ]; clear H.
+ rewrite H2; simpl ((N.of_nat 2 - 1)%N); simpl (N.add (Npos _) (Npos _)).
+ apply BVEq_iff_eq in HQ; rewrite HQ Bv2N_N2Bv_sized; [ lia | ].
+ apply /N.ltb_spec0.
+ destruct ((Bv2N rda0 + 1 <? 2 ^ N.of_nat ADDR_WIDTH)%N) eqn:Hcont; [ done | ].
+ move: Hcont => /negP /negP Hcont; rewrite -N.leb_antisym in Hcont.
+ move: Hcont => /N.leb_spec0 Hcont.
+ unfold ADDR_WIDTH in Hcont; rewrite QUEUE_MAX_SIZE_PW2_N in Hcont.
+ rewrite leq_eqVlt in Hleq; move: Hleq => /orP [/eqP Hbug | Hltn].
+ { specialize (@Bv2N_inj ADDR_WIDTH rda0 wra0) as HH.
+ apply Bv_eq_translation in Hbug; apply HH in Hbug; by rewrite Hbug in Hadr. }
+ { apply N.le_lteq in Hcont; destruct Hcont as [Hcont0 | Hcont1];
+ specialize (@Bv2N_upper_bound_nat ADDR_WIDTH wra0) as H;
+ apply Bv_ltn_translation in Hltn;
+ apply to_nat_lt_pow in H;
+ rewrite /ADDR_WIDTH QUEUE_MAX_SIZE_PW2_N in H;
+ apply lt_trans_le with (p := N.of_nat QUEUE_MAX_SIZE) in Hltn; try by apply ltN_ltn.
+ { contradict Hcont0; apply N.lt_asymm; by apply leN_leqn in Hltn. }
+ { contradict Hcont1; apply N.neq_sym; apply N.lt_neq; by apply leN_leqn. }
+ }
+ }
+ { apply BVEq_iff_eq in H; rewrite -H Bv2N_N2Bv_sized; [ lia | ].
+ move: Hleq => /negP /negP Hleq; rewrite -ltnNge in Hleq; rename Hleq into Hltn.
+ apply /N.ltb_spec0.
+ destruct ((Bv2N wra0 + 1 <? 2 ^ N.of_nat ADDR_WIDTH)%N) eqn:Hcont; [ done | ].
+ unfold ADDR_WIDTH in Hcont; rewrite QUEUE_MAX_SIZE_PW2_N in Hcont.
+ move: Hcont => /negP /negP Hcont; rewrite -N.leb_antisym in Hcont; move: Hcont => /N.leb_spec0 Hcont.
+ apply N.le_lteq in Hcont; destruct Hcont as [Hcont0 | Hcont1];
+ specialize (@Bv2N_upper_bound_nat ADDR_WIDTH rda0) as Hub;
+ apply Bv_ltn_translation in Hltn;
+ apply to_nat_lt_pow in Hub;
+ rewrite /ADDR_WIDTH QUEUE_MAX_SIZE_PW2_N in Hub;
+ apply lt_trans_le with (p := N.of_nat QUEUE_MAX_SIZE) in Hltn; try by apply ltN_ltn.
+ { contradict Hcont0; apply N.lt_asymm; by apply leN_leqn in Hltn. }
+ { contradict Hcont1; apply N.neq_sym; apply N.lt_neq; by apply leN_leqn. }
+ }
+ }
+ { simpl; apply BVEq_iff_eq in HQ; apply /andP; split.
+ { apply /negPf; apply BVEq_iff_neq.
+ apply Bvector_neq_N2Bv_sized_p1_neq; [ apply /ltP; exact ADDR_WIDTH_pos | done]. }
+ { rewrite HQ; by apply BVEq_iff_eq. }
+ }
+ }
+ move: HQ => /andP [neq HQ].
+ specialize (IHr1 wra0 (N2Bv_sized ADDR_WIDTH (Bv2N rda0 + 1))); apply IHr1 in HQ as IH; clear IHr1.
+ 3: {
+ move: neq => /negPf neq; apply BVEq_iff_neq in neq.
+ apply notfull_rd; done.
+ }
+ 2: by move: neq => /negPf neq; apply BVEq_iff_neq in neq.
+ simpl; apply /andP; split.
+ { move: IH => /andP [neq_ IH].
+ apply /negPf; apply BVEq_iff_neq.
+ apply notfull_adrs; try done.
+ }
+ exact IH.
+ Qed.
+
+ Fixpoint EqMem_ {W} (P : Requests_t) (rda : Bvector W)
+ (memcells_vec : Vector.t (Bvector REQUEST_WIDTH) (Nat.pow 2 W)) : bool :=
+ match P with
+ | [::] => true
+ | x :: x0 =>
+ let nrda := N2Bv_sized W (Bv2N rda + 1) in
+ let s := nth_default REQUEST_NIL (N.to_nat (Bv2N rda)) memcells_vec in
+ (EqReq x s) && (EqMem_ x0 nrda memcells_vec)
+ end.
+
+ Lemma EqMem_rcons r1 (rda wra : Bvector ADDR_WIDTH) c R (c_req : combType (Vec Bit REQUEST_WIDTH)) :
+ EqQueue r1 wra rda ->
+ EqMem_ r1 rda (@Cells_data (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem c) ->
+ EqReq R c_req ->
+ EqMem_ (r1 ++ [R])%SEQ rda (Cells_read true (N.to_nat (Bv2N wra)) c_req c).
+ Proof.
+ intros HQ Mem EqR; fold mem_cells_ in c; rewrite cats1.
+ revert Mem HQ; generalize wra rda; induction r1; intros.
+ { simpl; rewrite andb_true_r; simpl in HQ; apply BVEq_iff_eq in HQ; rewrite HQ.
+ rewrite VectorSpec.map_id.
+ unfold ADDR_WIDTH in wra,rda.
+ specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem
+ rda0 c_req REQUEST_NIL) as HH; rewrite /REQUEST_NIL bitvec_literal_correct //= in HH;
+ unfold mem_cells_ in c; by rewrite HH. }
+ simpl in Mem,HQ; simpl.
+ move: Mem => /andP [EqR_ Mem]; apply /andP; split.
+ { move: HQ => /andP [/negPf Heq HQ];
+ apply BVEq_iff_neq in Heq; rewrite VectorSpec.map_id; rewrite VectorSpec.map_id in EqR_.
+ rewrite -memcell_nch; done.
+ }
+ { move: HQ => /andP [neq HQ].
+ specialize (IHr1 wra0 (N2Bv_sized ADDR_WIDTH (Bv2N rda0 + 1))); apply IHr1; done.
+ }
+ Qed.
+
+ (* Just use the circuit directly <-> circuit does the work directly *)
+ Definition EqMem (P : Requests_t) rda (mem : circuit_state RequestQueue') :=
+ let memcells_vec := Cells_data (get_memcells_RequestQueue mem) in
+ EqMem_ P rda memcells_vec.
+
+ Definition State_Eq (fram_state : FIFO_state_t) (cava_state : State_t) : bool :=
+ let s := get_st cava_state in
+ let c' := get_cnt cava_state in
+ let cref' := get_cref cava_state in
+ let r' := get_cr cava_state in
+ let RQ := get_reqqueue cava_state in
+ let wra := fst (get_addr_RequestQueue RQ) in
+ let rda := snd (get_addr_RequestQueue RQ) in
+ match fram_state with
+ | IDLE c cref P =>
+ (s =? STATE_IDLE_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) &&
+ (EqMem P rda RQ) && (EqQueue P wra rda)
+ | RUNNING c cref P r =>
+ (s =? STATE_RUN_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
+ (EqQueue P wra rda) && (EqReq r r')
+ | REFRESHING cref P =>
+ (s =? STATE_REF_VEC) && (cref' =? cref2Bv cref) &&
+ (EqMem P rda RQ) && (EqQueue P wra rda)
+ end.
+
+ (* -------------- Proofs about CmdGen ------------------------------- *)
+ Lemma CmdGen_equiv_idle_to_idle_E (c : circuit_state CmdGen) cnt cref:
+ (cref =? CNT_REF_PREA) = false ->
+ exists c', step CmdGen c (STATE_IDLE_VEC,true,cnt,cref,REQUEST_NIL) =
+ (c',NOP_VEC).
+ Proof.
+ intros H; simpl in c; destruct_products.
+ eapply ex_intro.
+ cbv [CmdGen]; cbn [step fst snd].
+ simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; simpl.
+ cbv [CrefPREA_eq].
+ apply BVEq_iff_neq in H.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply HH in H; rewrite H VectorSpec.map_id; reflexivity.
+ Qed.
+
+ Lemma CmdGen_equiv_idle_to_idle (c : circuit_state CmdGen) cnt cref:
+ (cref2Bv cref =? CNT_REF_PREA) = false ->
+ (cref + WAIT < PREA_date) = false ->
+ exists c', step CmdGen c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref),REQUEST_NIL) =
+ (c',NOP_VEC).
+ Proof.
+ intros H Href_service; simpl in c; destruct_products; eapply ex_intro.
+ cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; simpl.
+ cbv [CrefPREA_eq]; apply BVEq_iff_neq in H.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply HH in H; rewrite H !VectorSpec.map_id.
+ rewrite CrefPREA_lt_CNT_REF_WAIT_F; done.
+ Qed.
+
+ Lemma CmdGen_equiv_idle_to_ref (c : circuit_state CmdGen) cnt cref e:
+ (cref =? CNT_REF_PREA) = true ->
+ exists c', step CmdGen c (STATE_IDLE_VEC,e,cnt,cref,REQUEST_NIL) = (c',PREA_VEC).
+ Proof.
+ intros; simpl in c; destruct_products; eapply ex_intro.
+ cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; simpl; rewrite VectorSpec.map_id.
+ apply BVEq_iff_eq in H; subst cref; rewrite CrefPREA_lt_CNT_REF_PREA !VectorSpec.map_id.
+ rewrite andb_false_r; rewrite /CrefPREA_eq.
+ specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ assert (CNT_REF_PREA = CNT_REF_PREA); [done | ]; apply HH in H; by rewrite H.
+ Qed.
+
+ Lemma CmdGen_equiv_idle_to_running (c : circuit_state CmdGen) cnt cref tr:
+ (cref2Bv cref =? CNT_REF_PREA) = false ->
+ (cref + WAIT < PREA_date) = true ->
+ exists c', step CmdGen c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref),tr) = (c',PRE_VEC).
+ Proof.
+ intros; simpl in c; destruct_products; eapply ex_intro.
+ cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; simpl; rewrite !VectorSpec.map_id.
+ rewrite CrefPREA_lt_CNT_REF_WAIT; done.
+ Qed.
+ (* ------------------------------------------------------------------ *)
+
+ (* -------------- Proofs about NextCR ------------------------------- *)
+ Lemma NextCR_equiv (c : circuit_state NextCR) cnt cref tr:
+ exists c', step NextCR c (STATE_IDLE_VEC,true,cnt,cref,tr) =
+ (c',REQUEST_NIL).
+ Proof.
+ simpl in c; destruct_products.
+ eapply ex_intro.
+ cbv [NextCR LoopInit]; cbn [step fst snd].
+ simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; by simpl.
+ Qed.
+
+ Lemma NextCR_equiv_IDLE_NE_PREA c cnt cref tr:
+ (cref =? CNT_REF_PREA) = true ->
+ exists c', step NextCR c (STATE_IDLE_VEC,false,cnt,cref,tr) =
+ (c',REQUEST_NIL).
+ Proof.
+ intros; simpl in c; destruct_products; eapply ex_intro.
+ cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
+ apply BVEq_iff_eq in H; subst cref.
+ by rewrite CrefPREA_lt_CNT_REF_PREA.
+ Qed.
+
+ Lemma NextCR_equiv_IDLE_IDLE c cnt (cref : Counter_ref_t) tr:
+ (cref + WAIT < PREA_date) = false ->
+ exists c', step NextCR c (STATE_IDLE_VEC,false,cnt,cref2Bv cref,tr) =
+ (c',REQUEST_NIL).
+ Proof.
+ intros Href_service; simpl in c; destruct_products; eapply ex_intro.
+ cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
+ rewrite CrefPREA_lt_CNT_REF_WAIT_F; done.
+ Qed.
+
+ Lemma NextCR_equiv_IDLE_RUNNING c cnt (cref : Counter_ref_t) tr:
+ (cref2Bv cref =? CNT_REF_PREA) = false ->
+ (cref + WAIT < PREA_date) = true ->
+ exists c',
+ step NextCR c (STATE_IDLE_VEC,false,cnt,cref2Bv cref,tr) = (c',tr) /\
+ (snd (snd c')) = tr.
+ Proof.
+ intros Href_service Href_prea; simpl in c; destruct_products; eapply ex_intro.
+ cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
+ rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
+ rewrite CrefPREA_lt_CNT_REF_WAIT; done.
+ Qed.
+ (* ------------------------------------------------------------------ *)
+
+ Create HintDb update.
+ Lemma Sidle_true :
+ Sidle STATE_IDLE_VEC = true.
+ Proof.
+ apply CavaPreludeProperties.eqb_refl.
+ Qed.
+ Hint Rewrite @Sidle_true : update.
+
+ Lemma Sref_idle_false :
+ Sref STATE_IDLE_VEC = false.
+ Proof.
+ by apply CavaPreludeProperties.eqb_neq.
+ Qed.
+ Hint Rewrite @Sref_idle_false : update.
+
+ Lemma cnt_equiv (cnt : Bvector COUNTER_WIDTH) :
+ (if CeqWAIT cnt then Bvect_false COUNTER_WIDTH
+ else N2Bv_sized COUNTER_WIDTH (Bv2N cnt + 1)) = cnt2Bv (Next_cycle (Bv2cnt cnt)).
+ Proof.
+ cbv [CeqWAIT].
+ destruct (CavaPrelude.eqb (cnt, CNT_WAIT)) eqn:Heq; rewrite Heq.
+ { specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit COUNTER_WIDTH) (x := cnt) as H.
+ apply H in Heq; clear H.
+ unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { rewrite /CNT_WAIT bitvec_literal_correct in Heq.
+ rewrite Heq /Bv2cnt //= Bv2N_N2Bv_sized in x.
+ 2: {
+ rewrite /COUNTER_WIDTH; have id := (N2Nat.id 2).
+ rewrite -id Nat2N.inj_pow //= /Pos.to_nat //= WAIT_PW_2.
+ apply: N_lt_inj; apply /ltP; by rewrite subn1 ltn_predL WAIT_pos.
+ }
+ rewrite Nat2N.id subn1 prednK in x; [ | exact WAIT_pos ]; by rewrite ltnn in x.
+ }
+ { unfold cnt2Bv,OCycle0; by simpl. }}
+ { unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { unfold cnt2Bv; apply f_equal; simpl.
+ rewrite N.add_1_r -(N.succ_pos_pred (Pos.of_succ_nat (N.to_nat (Bv2N cnt)))).
+ apply f_equal; by rewrite predN_of_succ_nat. }
+ { apply ltn_gt in e,x.
+ rewrite leq_eqVlt in e; move: e => /orP [/eqP e | e].
+ { have HH := (@eqb_iff_neq (Vec Bit (@COUNTER_WIDTH SYS_CFG FIFO_CFG))).
+ apply HH in Heq. rewrite /CNT_WAIT bitvec_literal_correct in Heq;
+ rewrite -(N2Bv_sized_Bv2N (@COUNTER_WIDTH SYS_CFG FIFO_CFG) cnt) in Heq.
+ apply N2Bv_sized_neq_if in Heq.
+ by rewrite e subn1 -pred_Sn N2Nat.id in Heq. }
+ { specialize ltn_ord with (n := @WAIT SYS_CFG FIFO_CFG) (i := Ordinal (cnt_bounded cnt)) as H.
+ rewrite //= in H.
+ contradict H; apply /negP; by rewrite -ltnNge.
+ }
+ }
+ }
+ Qed.
+
+ (* -------------- Proofs about Update ------------------------------- *)
+ Lemma Update_equiv_idle_idle_E (c : circuit_state Update) cnt cref :
+ (cref =? CNT_REF_PREA) = false ->
+ let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
+ let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N cref + 1) in
+ exists c', step Update_ c (STATE_IDLE_VEC,true,cnt,cref) =
+ (c',(STATE_IDLE_VEC,nc,ncref)).
+ Proof.
+ intros Hcref Hcnt; simpl in c; eapply ex_intro.
+ cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
+ cbv [Update_ Update_s Update_c Update_cref].
+ cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ autorewrite with update; vm_compute (false && _).
+ apply BVEq_iff_neq in Hcref.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply pair_equal_spec; split.
+ 2: {
+ rewrite orb_false_l andb_true_l.
+ rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
+ }
+ cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
+ vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id andb_false_r.
+ apply pair_equal_spec; split; [ done | ].
+ vm_compute (orb false false); rewrite orb_false_r; by specialize (cnt_equiv cnt).
+ Qed.
+
+ Lemma Update_equiv_idle_idle (c : circuit_state Update) cnt cref :
+ (cref2Bv cref =? CNT_REF_PREA) = false ->
+ (cref + WAIT < PREA_date) = false ->
+ let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
+ let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N (cref2Bv cref) + 1) in
+ exists c', step Update_ c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref)) =
+ (c',(STATE_IDLE_VEC,nc,ncref)).
+ Proof.
+ intros Hcref Href_service Hcnt; simpl in c; eapply ex_intro.
+ cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
+ cbv [Update_ Update_s Update_c Update_cref].
+ cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ autorewrite with update; vm_compute (false && _).
+ apply BVEq_iff_neq in Hcref.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply pair_equal_spec; split.
+ 2: {
+ rewrite orb_false_l andb_true_l /CrefPREA_eq.
+ apply HH in Hcref; by rewrite Hcref.
+ }
+ cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
+ vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id andb_true_r !orb_false_r.
+ rewrite !CrefPREA_lt_CNT_REF_WAIT_F; [ | done].
+ rewrite //=.
+ apply pair_equal_spec; split; [ done | ].
+ rewrite orb_false_r; by specialize (cnt_equiv cnt).
+ Qed.
+
+ Lemma Update_equiv_idle_ref (c : circuit_state Update) cnt cref e:
+ (cref =? CNT_REF_PREA) = true ->
+ let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
+ let ncref := CNT_REF_NIL in
+ exists c', (step Update_ c (STATE_IDLE_VEC,e,cnt,cref)) =
+ (c',(STATE_REF_VEC,nc,ncref)).
+ Proof.
+ intros Hcref Hcnt; simpl in c; eapply ex_intro.
+ cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
+ cbv [Update_ Update_s Update_e Update_c Update_cref].
+ cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ autorewrite with update; vm_compute (false && _).
+ apply BVEq_iff_eq in Hcref.
+ specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply pair_equal_spec; split.
+ 2: {
+ rewrite orb_false_l andb_true_l.
+ rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
+ }
+ cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
+ vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id.
+ apply pair_equal_spec; split.
+ 2: {
+ vm_compute (orb false false); rewrite orb_false_r.
+ destruct e; [rewrite negb_true | rewrite negb_false].
+ { rewrite andb_false_r orb_false_r; by specialize (cnt_equiv cnt). }
+ { rewrite andb_true_r.
+ destruct (CrefPREA_lt cref) eqn:Hbug.
+ { by rewrite Hcref CrefPREA_lt_CNT_REF_PREA in Hbug. }
+ { rewrite orb_false_r; by specialize (cnt_equiv cnt). }
+ }
+ }
+ done.
+ Qed.
+
+ Lemma Update_equiv_idle_running (c : circuit_state Update) cnt
+ (cref : Counter_ref_t) :
+ (cref2Bv cref =? CNT_REF_PREA) = false ->
+ (cref + WAIT < PREA_date) = true ->
+ let nc := CNT_NIL in
+ let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N (cref2Bv cref) + 1) in
+ exists c', step Update_ c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref)) =
+ (c',(STATE_RUN_VEC,nc,ncref)).
+ Proof.
+ intros Href_prea Href_service Hcnt;
+ simpl in c; destruct_products; eapply ex_intro.
+ cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
+ cbv [Update_ Update_s Update_e Update_c Update_cref].
+ cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ];
+ autorewrite with update; fast_simpl_bool.
+ rewrite !orb_false_l !andb_true_l /CrefPREA_eq.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply BVEq_iff_neq in Href_prea as Haux; apply HH in Haux.
+ rewrite Haux //= !orb_false_r andb_true_r !VectorSpec.map_id; clear Haux.
+ apply pair_equal_spec; split; [ | done].
+ apply pair_equal_spec; split; rewrite CrefPREA_lt_CNT_REF_WAIT; try done.
+ by rewrite orb_true_r.
+ Qed.
+ (* ------------------------------------------------------------------ *)
+
+ (* ----------------------------- Cases ------------------------------ *)
+ Theorem SM_Eq_3b (t : nat) (c_state : State_t) c0 (r0 r : Request_t) r1
+ (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) :
+ (c1 + WAIT < PREA_date) = false ->
+ (nat_of_ord c1 == PREA_date - 1) = false ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Proof.
+ intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM_.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rewrite NF //= in NFULL; cbv [get_wra get_rda get_fields] in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
+ rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
+
+ move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] HQ].
+ apply EqQueue_diff_adr in HQ as Hadr.
+
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret; cbv [and2]; cbn [fst snd].
+
+ assert ((Sidle STATE_IDLE_VEC && CrefPREA_lt (cref2Bv c1)) = false) as Haux;
+ [ apply CrefPREA_lt_CNT_REF_WAIT_F in Href_service; by rewrite Href_service andb_false_r | ].
+ rewrite Haux; clear Haux.
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ apply (Queue_WR_NF_NE_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) in NFULL as S;
+ apply S in Hadr as S'; clear S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S'.
+ destruct S' as [full_o H]; rewrite H; clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ apply (NextCR_equiv_IDLE_IDLE (u7, (u8, cr)) (cnt2Bv c0) c1 tr) in Href_service as H.
+ destruct H as [cs_nextcr H]; rewrite H; clear H; cbn [fst snd].
+
+ apply cref_preadate_false in Href_prea as Href_prea_.
+ apply (CmdGen_equiv_idle_to_idle u5 (cnt2Bv c0) c1) in Href_prea_ as H; [ | done ].
+ destruct H as [cs_cmdgen H]; rewrite H; clear H; cbn [fst snd].
+
+ apply (Update_equiv_idle_idle u3 (cnt2Bv c0) c1) in Href_prea_ as H; [ | done].
+ destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
+
+ rewrite /Next_state Href_prea Href_service /State_Eq.
+ specialize (Queue_WR_NF_NE_fst (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra)) c_req false) as S.
+ apply S in NFULL as H; clear S; apply H in Hadr as H'; clear H; rename H' into H.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ autounfold with get_state.
+
+ apply /andP; split.
+ 2 : exact EqReqNil.
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H.
+ cbv [get_addr_RequestQueue] in Hwra'; rewrite Hwra'; clear Hwra'.
+ cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
+ rewrite /Enqueue /R NF.
+ apply (EqQueue_aux wra rda r0 r1 r); done.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite /EqMem (surjective_pairing (step RequestQueue' _ _)) H Hrda'; cbn [fst snd];
+ unfold R; rewrite NF Hrw /Enqueue.
+ cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
+ apply EqMem_rcons; try done.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H;
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; cbn [fst snd].
+ rewrite //= /Next_cycle_ref.
+ set Hc := c1.+1 < PREA_date; dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { rewrite /cref2Bv //= Bv2N_N2Bv_sized.
+ 2: apply to_nat_lt_pow; rewrite Nat2N.id; apply cref_bound.
+ rewrite /N2Bv_sized.
+ destruct (N.of_nat c1 + 1)%N eqn:Hbug;
+ [ rewrite N.add_1_r in Hbug; contradict Hbug; apply N.neq_succ_0 | ].
+ apply BVEq_iff_eq; f_equal; lia.
+ }
+ { specialize (cref_bound c1) as Hc1_bound.
+ destruct c1; clear H Hrw Hwra' Hrda' cs_requeue' cs_nextcr; simpl in *.
+ apply ltn_gt in x; rewrite leq_eqVlt in x; move: x => /orP [/eqP x | x]; [ | lia].
+ assert (m = PREA_date.-1); [ lia | ].
+ rewrite H in Href_prea; contradict Href_prea; apply not_false_iff_true; by rewrite subn1 eq_refl.
+ }
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H;
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; cbn [fst snd].
+ rewrite /cnt2Bv //=; apply BVEq_iff_eq; f_equal; apply Nat2N.inj_iff.
+ rewrite /Bv2cnt /Next_cycle //= Bv2N_N2Bv_sized //=.
+ 2: {
+ destruct c0; rewrite //= /COUNTER_WIDTH.
+ rewrite WAIT_PW_2_N; apply N_lt_inj; by apply /ltP.
+ }
+ set (Hc := _ < WAIT); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro; try rewrite Nat2N.id;
+ try by rewrite Nat2N.id in x; move: Logic.eq_refl; rewrite {2 3}x; simpl; intro.
+ }
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H;
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; cbn [fst snd].
+ by [].
+ Qed.
+
+ Theorem SM_Eq_3a (t : nat) (c_state : State_t) c0 (r : Request_t)
+ (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) :
+ (c1 + WAIT < PREA_date) = false ->
+ (nat_of_ord c1 == PREA_date - 1) = false ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 []) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Proof.
+ intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM_.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rewrite NF //= in NFULL; cbv [get_wra get_rda get_fields] in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
+ rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
+
+ move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr].
+ simpl in Hadr.
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref, Hadr; subst s cnt cref.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret; cbv [and2]; cbn [fst snd].
+
+ assert ((Sidle STATE_IDLE_VEC && CrefPREA_lt (cref2Bv c1)) = false) as Haux;
+ [ apply CrefPREA_lt_CNT_REF_WAIT_F in Href_service; by rewrite Href_service andb_false_r | ].
+ rewrite Haux; clear Haux.
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ specialize (Queue_WR_E_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
+ apply S in Hadr as H; clear S; destruct H as [full_o H].
+ rewrite H; clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ specialize NextCR_equiv with (c := (u7, (u8, cr))) (cnt := cnt2Bv c0)
+ (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
+ rewrite H; cbv [fst]; clear H. cbn [snd].
+
+ apply cref_preadate_false in Href_prea as Href_prea_.
+ apply (CmdGen_equiv_idle_to_idle_E u5 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
+ destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
+
+ apply (Update_equiv_idle_idle_E u3 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
+ destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
+
+ rewrite /Next_state Href_prea Href_service /State_Eq.
+ specialize (Queue_WR_NF_E_fst (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra)) c_req false) as S.
+ apply S in NFULL as H; clear S; apply H in Hadr as H'; clear H; rename H' into H.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ autounfold with get_state.
+
+ apply /andP; split.
+ 2 : exact EqReqNil.
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H.
+ cbv [get_addr_RequestQueue] in Hwra'; rewrite Hwra'; clear Hwra'.
+ cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
+ simpl; rewrite Hadr; unfold R; rewrite NF //=.
+ apply /andP; split.
+ { apply /negPf; apply (@N2Bv_sized_eq_p1_false ADDR_WIDTH rda);
+ specialize ADDR_WIDTH_pos as Hpos; by move: Hpos => /ltP Hpos. }
+ by apply BVEq_iff_eq.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H.
+ cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
+ simpl; unfold R; rewrite NF //= /EqMem //= andb_true_r.
+ rewrite Hrw; autounfold with get_state; rewrite Hadr VectorSpec.map_id.
+ specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req
+ (Bvect_false REQUEST_WIDTH) c) as H'.
+ rewrite H'; exact EqR.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H;
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; cbn [fst snd].
+ rewrite //= /Next_cycle_ref.
+ set Hc := c1.+1 < PREA_date; dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { rewrite /cref2Bv //= Bv2N_N2Bv_sized.
+ 2: apply to_nat_lt_pow; rewrite Nat2N.id; apply cref_bound.
+ rewrite /N2Bv_sized.
+ destruct (N.of_nat c1 + 1)%N eqn:Hbug;
+ [ rewrite N.add_1_r in Hbug; contradict Hbug; apply N.neq_succ_0 | ].
+ apply BVEq_iff_eq; f_equal; lia.
+ }
+ { specialize (cref_bound c1) as Hc1_bound.
+ destruct c1; clear H Hrw Hwra' Hrda' cs_requeue' cs_nextcr; simpl in *.
+ apply ltn_gt in x; rewrite leq_eqVlt in x; move: x => /orP [/eqP x | x]; [ | lia].
+ assert (m = PREA_date.-1); [ lia | ].
+ rewrite H in Href_prea; contradict Href_prea; apply not_false_iff_true; by rewrite subn1 eq_refl.
+ }
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H;
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; cbn [fst snd].
+ rewrite /cnt2Bv //=; apply BVEq_iff_eq; f_equal; apply Nat2N.inj_iff.
+ rewrite /Bv2cnt /Next_cycle //= Bv2N_N2Bv_sized //=.
+ 2: {
+ destruct c0; rewrite //= /COUNTER_WIDTH.
+ rewrite WAIT_PW_2_N; apply N_lt_inj; by apply /ltP.
+ }
+ set (Hc := _ < WAIT); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro; try rewrite Nat2N.id;
+ try by rewrite Nat2N.id in x; move: Logic.eq_refl; rewrite {2 3}x; simpl; intro.
+ }
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H;
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; cbn [fst snd].
+ by [].
+ Qed.
+
+ Theorem SM_Eq_2b (t : nat) (c_state : State_t) c0 r0 r1
+ (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) r :
+ (c1 + WAIT < PREA_date) = true ->
+ (nat_of_ord c1 == PREA_date - 1) = false ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Proof.
+ intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM_.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rewrite NF //= in NFULL; cbv [get_wra get_rda get_fields] in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
+ rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
+
+ move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] HQ].
+ apply EqQueue_diff_adr in HQ as Hadr.
+
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret; cbv [and2].
+ assert ((Sidle STATE_IDLE_VEC && CrefPREA_lt (cref2Bv c1)) = true) as Haux; [
+ rewrite //= ; apply CrefPREA_lt_CNT_REF_WAIT;
+ [ by apply cref_preadate_false in Href_prea | done ] | ]; rewrite Haux; clear Haux; cbn [snd].
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ specialize (Queue_WR_NF_NE_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req true) as S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
+ apply S in NFULL as S'; [ | done]; clear S; destruct S' as [full_o H].
+ rewrite H; clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ apply NextCR_equiv_IDLE_RUNNING with (c := (u7, (u8, cr))) (cnt := cnt2Bv c0)
+ (cref := c1) (tr := tr) in Href_service as H.
+ 2: by apply cref_preadate_false in Href_prea.
+ destruct H as [cs_nextcr H]; destruct H as [H Htr].
+ rewrite H; clear H; cbv [fst snd].
+
+ specialize (CmdGen_equiv_idle_to_running u5 (cnt2Bv c0) c1 tr) as S.
+ specialize Href_service as Href_service_.
+ apply S in Href_service; clear S; rename Href_service into H.
+ 2: by apply cref_preadate_false in Href_prea.
+ destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
+
+ specialize (Update_equiv_idle_running u3 (cnt2Bv c0) c1) as S;
+ apply S in Href_service_ as S'; clear S.
+ 2: by apply cref_preadate_false in Href_prea.
+ destruct S' as [cs_update H]; rewrite H; clear H; cbn [fst snd].
+
+ rewrite /Next_state Href_prea Href_service_ /State_Eq.
+ specialize Queue_NF_WR_RD_fst with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
+ apply S in NFULL as H; clear S.
+ apply H in Hadr as H'; clear H; rename H' into H.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ autounfold with get_state.
+
+ apply /andP; split.
+ 2: {
+ unfold tr; simpl in Mem; move: Mem => /andP [EqReq_r0 Mem].
+ rewrite {2}/get_memcells_RequestQueue /get_mem_RequestQueue /get_memcells in Hrw.
+ apply (memcell_nch c wra rda c_req req_null) in Hadr as HH.
+ rewrite /req_null //= in HH.
+ rewrite VectorSpec.map_id /Bvect_false HH in EqReq_r0.
+ by rewrite /req_null //=.
+ }
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2 : {
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; rewrite Htr;
+ unfold tr; simpl in Mem; move: Mem => /andP [EqReq_r0 Mem].
+ rewrite {2}/get_memcells_RequestQueue /get_mem_RequestQueue /get_memcells in Hrw.
+ apply (memcell_nch c wra rda c_req req_null) in Hadr as HH.
+ rewrite /req_null //= in HH.
+ rewrite VectorSpec.map_id /Bvect_false HH in EqReq_r0.
+ by rewrite /req_null //=.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
+ simpl; rewrite eq_refl.
+ rewrite /Enqueue /R NF.
+ simpl in HQ.
+ specialize (EqQueue_aux wra rda r0 r1 r) as HH.
+ apply HH in NFULL as HH'; clear HH; try done.
+ move: HH'; simpl; intros HH.
+ by move: HH => /andP [_ HH].
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite /EqMem (surjective_pairing (step RequestQueue' _ _)) H Hrda' /Enqueue.
+ simpl; unfold R; rewrite NF //=.
+ rewrite Hrw eq_refl.
+ simpl in Mem; move: Mem => /andP [_ Mem].
+ apply EqMem_rcons; try done.
+ simpl in HQ; by move: HQ => /andP [_ HQ].
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ rewrite VectorSpec.map_id; cbn [fst snd].
+ rewrite /Next_cycle_ref.
+ set Hc := c1.+1 < WAIT_REF; dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { rewrite /cref2Bv //= Bv2N_N2Bv_sized.
+ 2: {
+ unfold COUNTER_REF_WIDTH; rewrite WAIT_REF_PW_N.
+ destruct c1; simpl; apply N_lt_inj; by apply /ltP.
+ }
+ rewrite /N2Bv_sized.
+ destruct (N.of_nat c1 + 1)%N eqn:Hbug;
+ [ rewrite N.add_1_r in Hbug; contradict Hbug; apply N.neq_succ_0 | ].
+ apply BVEq_iff_eq; f_equal; lia.
+ }
+ { apply cref_preadate_false in Href_prea as Href_prea_.
+ destruct c1; simpl in x,e,Hc0,Href_service_,Href_prea,Href_prea_.
+ rewrite /cref2Bv VectorSpec.map_id //= in Href_prea_.
+ apply ltn_gt in x; rewrite leq_eqVlt in x; move: x => /orP [/eqP x | x].
+ { assert (m = WAIT_REF.-1); [ lia | ].
+ rewrite H0 addnC -ltn_subRL in Href_service_.
+ rewrite -subn1 ltn_subLR in Href_service_; [ | exact WAIT_REF_pos ].
+ contradict Href_service_; apply /negP.
+ rewrite -leqNgt leq_eqVlt addnC.
+ specialize WAIT_REF_PREA_date as HH.
+ apply ltn_trans with (m := PREA_date - WAIT + 1) in HH;
+ [ by rewrite HH orb_true_r | ].
+ rewrite -subnA.
+ { by rewrite ltn_subrL subn_gt0 WAIT_gt_one PREA_date_pos. }
+ { exact WAIT_pos. }
+ { by rewrite leq_eqVlt PREA_date_WAIT orb_true_r. }
+ }
+ { rewrite ltnS in x; contradict x; apply /negP; by rewrite -ltnNge. }
+ }
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end. cbn [fst snd]. rewrite VectorSpec.map_id.
+ rewrite /cnt2Bv; apply BVEq_iff_eq; f_equal.
+ rewrite /Bv2cnt /Next_cycle //= Bv2N_N2Bv_sized //=.
+ }
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; cbn [fst snd]. by [].
+ Qed. *)
+
+ Theorem SM_Eq_2a (t : nat) (c_state : State_t) c0
+ (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) r :
+ (c1 + WAIT < PREA_date) = true ->
+ (nat_of_ord c1 == PREA_date - 1) = false ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 []) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Admitted.
+ (* Proof.
+ intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM_.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rewrite NF //= in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
+ rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
+ move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr].
+ simpl in Hadr.
+
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref, Hadr; subst s cnt cref.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
+ cbv [and2].
+ assert ((Sidle STATE_IDLE_VEC && CrefPREA_lt (cref2Bv c1)) = true) as Haux; [
+ rewrite //= ; apply CrefPREA_lt_CNT_REF_WAIT;
+ [ by apply cref_preadate_false in Href_prea | done ] | ]; rewrite Haux; clear Haux.
+ cbn [snd].
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ specialize (Queue_EMP_WR_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req true) as S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
+ apply S in Hadr as H; clear S; destruct H as [full_o H].
+ rewrite H; clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ specialize NextCR_equiv with (c := (u7, (u8, cr))) (cnt := cnt2Bv c0)
+ (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
+ rewrite H; cbv [fst]; clear H. cbn [snd].
+
+ apply cref_preadate_false in Href_prea as Href_prea_.
+ apply (CmdGen_equiv_idle_to_idle_E u5 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
+ destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
+
+ apply (Update_equiv_idle_idle_E u3 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
+ destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
+
+ cbv [get_rda get_wra get_fields] in NFULL.
+ rewrite /Next_state Href_prea Href_service /State_Eq.
+ specialize Queue_NF_EMP_WR_fst with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
+ apply S in NFULL as H; clear S. apply H in Hadr as H'; clear H; rename H' into H.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ autounfold with get_state.
+
+ apply /andP; split.
+ 2 : exact EqReqNil.
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
+ simpl; rewrite Hadr; unfold R; rewrite NF //=.
+ apply /andP; split.
+ { apply /negPf; apply (@N2Bv_sized_eq_p1_false ADDR_WIDTH rda);
+ specialize ADDR_WIDTH_pos as Hpos; by move: Hpos => /ltP Hpos. }
+ by apply BVEq_iff_eq.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hrda'.
+ simpl; unfold R; rewrite NF //= /EqMem //= andb_true_r.
+ rewrite Hrw; autounfold with get_state; rewrite Hadr VectorSpec.map_id.
+ specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req
+ (Bvect_false REQUEST_WIDTH) c) as H'.
+ rewrite H'; exact EqR.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ cbn [fst snd].
+ rewrite /Next_cycle_ref.
+ set Hc := c1.+1 < WAIT_REF; dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { rewrite /cref2Bv //= Bv2N_N2Bv_sized.
+ 2: {
+ unfold COUNTER_REF_WIDTH; rewrite WAIT_REF_PW_N.
+ destruct c1; simpl; apply N_lt_inj; by apply /ltP.
+ }
+ rewrite /N2Bv_sized.
+ destruct (N.of_nat c1 + 1)%N eqn:Hbug;
+ [ rewrite N.add_1_r in Hbug; contradict Hbug; apply N.neq_succ_0 | ].
+ apply BVEq_iff_eq; f_equal; lia.
+ }
+ { destruct c1; simpl in x,e,Hc0,Href_prea,Href_prea_,Href_service.
+ rewrite /cref2Bv VectorSpec.map_id //= in Href_prea_.
+ apply ltn_gt in x; rewrite leq_eqVlt in x; move: x => /orP [/eqP x | x].
+ { assert (m = WAIT_REF.-1); [ lia | ].
+ rewrite H0 addnC -ltn_subRL in Href_service.
+ rewrite -subn1 ltn_subLR in Href_service; [ | exact WAIT_REF_pos ].
+ contradict Href_service; apply /negP.
+ rewrite -leqNgt leq_eqVlt addnC.
+ specialize WAIT_REF_PREA_date as HH.
+ apply ltn_trans with (m := PREA_date - WAIT + 1) in HH;
+ [ by rewrite HH orb_true_r | ].
+ rewrite -subnA.
+ { by rewrite ltn_subrL subn_gt0 WAIT_gt_one PREA_date_pos. }
+ { exact WAIT_pos. }
+ { by rewrite leq_eqVlt PREA_date_WAIT orb_true_r. }
+ }
+ { rewrite ltnS in x; contradict x; apply /negP; by rewrite -ltnNge. }
+ }
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end. cbn [fst snd].
+ rewrite /cnt2Bv; apply BVEq_iff_eq; f_equal.
+ apply Nat2N.inj_iff.
+ rewrite /Bv2cnt /Next_cycle //= Bv2N_N2Bv_sized //=.
+ 2: {
+ destruct c0; rewrite //= /COUNTER_WIDTH.
+ rewrite WAIT_PW_2_N; apply N_lt_inj; by apply /ltP.
+ }
+ set (Hc := _ < WAIT); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro; try rewrite Nat2N.id;
+ try by rewrite Nat2N.id in x; move: Logic.eq_refl; rewrite {2 3}x; simpl; intro.
+ }
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; cbn [fst snd]. by [].
+ Qed. *)
+
+
+ (* Assuming a non-full regime, i.e., the front-end has yielded a valid request *)
+ (* If R is non empty than the queue is not full *)
+ Theorem SM_Eq_1b (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) r0 r1 (r : Request_t) :
+ (nat_of_ord c1 == PREA_date - 1) = true ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Admitted.
+ (* Proof.
+ intros Href_prea f_state R NF EqR H; unfold FIFOSM_.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rewrite NF //= in NFULL; cbv [get_wra get_rda get_fields] in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
+ rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
+ move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] HQ].
+ apply EqQueue_diff_adr in HQ as Hadr.
+
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
+
+ apply cref_preadate_true in Href_prea as Href_prea_;
+ apply BVEq_iff_eq in Href_prea_ as H'.
+ cbv [and2]. cbn [fst snd].
+ rewrite {1}H' CrefPREA_lt_CNT_REF_PREA andb_false_r.
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ specialize (Queue_NEMP_NF_WR_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
+ apply S in NFULL as S'; [ | done]; clear S; destruct S' as [full_o H].
+ rewrite H; clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ specialize (NextCR_equiv_IDLE_NE_PREA (u7, (u8, cr)) (cnt2Bv c0) (cref2Bv c1) tr) as S.
+ apply S in Href_prea_ as S'; clear S; destruct S' as [cs_nextcr H]; rewrite H.
+
+ cbn [fst snd]; clear H.
+ apply (CmdGen_equiv_idle_to_ref u5 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
+ destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
+
+ apply (Update_equiv_idle_ref u3 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
+ destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
+
+ rewrite /Next_state Href_prea /State_Eq.
+ specialize Queue_NF_WR_fst with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
+ apply S in NFULL as H; clear S.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ autounfold with get_state.
+
+ apply /andP; split.
+ 2 : exact EqReqNil.
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2 : {
+ rewrite H /Enqueue /R NF.
+ cbv [get_addr_RequestQueue] in Hwra'; rewrite Hwra'.
+ cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'.
+ by apply (EqQueue_aux wra rda r0 r1 r).
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite H.
+ cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
+ rewrite /EqMem Hrw /Enqueue.
+ autounfold with get_state; unfold R; rewrite NF.
+ apply EqMem_rcons; done.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite H.
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end. cbn [fst snd]; simpl; rewrite VectorSpec.map_id.
+ rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
+ }
+ rewrite H;
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; cbn [fst snd]. by [].
+ Qed. *)
+
+ Theorem SM_Eq_1a (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) r :
+ (nat_of_ord c1 == PREA_date - 1) = true ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 []) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Admitted.
+ (* Proof.
+ intros Href_prea f_state R NF EqR H; unfold FIFOSM_.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rewrite NF //= in NFULL; cbv [get_wra get_rda get_fields] in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda.
+ rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
+ move: H => /andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr].
+
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref,Hadr; subst s cnt cref.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
+
+ apply cref_preadate_true in Href_prea as Href_prea_;
+ apply BVEq_iff_eq in Href_prea_ as H'.
+ cbv [and2]. cbn [fst snd].
+ rewrite {1}H' CrefPREA_lt_CNT_REF_PREA andb_false_r.
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ specialize (Queue_EMP_WR_snd ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
+ apply S in Hadr as H; clear S; destruct H as [full_o H].
+ rewrite H; clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ specialize NextCR_equiv with (c := (u7, (u8, cr))) (cnt := cnt2Bv c0)
+ (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
+ rewrite H; cbv [fst snd]; clear H.
+
+ apply (CmdGen_equiv_idle_to_ref u5 (cnt2Bv c0) (cref2Bv c1) true) in Href_prea_ as H.
+ destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
+
+ apply (Update_equiv_idle_ref u3 (cnt2Bv c0) (cref2Bv c1) true) in Href_prea_ as H.
+ destruct H as [cs_update H]; rewrite H; clear H.
+
+ rewrite /Next_state Href_prea /State_Eq.
+ specialize Queue_NF_WR_fst with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
+ apply S in NFULL as H; clear S.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ autounfold with get_state.
+
+ apply /andP; split.
+ 2 : exact EqReqNil.
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2 : {
+ rewrite /Enqueue.
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H.
+ cbv [get_addr_RequestQueue] in Hwra'; rewrite Hwra'; clear Hwra'.
+ cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
+ rewrite //= /R NF //= Hadr.
+ apply /andP; split.
+ { apply /negPf; apply (@N2Bv_sized_eq_p1_false ADDR_WIDTH rda);
+ specialize ADDR_WIDTH_pos as Hpos; by move: Hpos => /ltP Hpos. }
+ by apply BVEq_iff_eq.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite /Enqueue.
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H.
+ cbv [get_addr_RequestQueue] in Hrda'; rewrite Hrda'; clear Hrda'.
+ simpl; unfold R; rewrite NF //= /EqMem //= andb_true_r VectorSpec.map_id.
+ rewrite Hrw; autounfold with get_state; rewrite Hadr.
+ specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req
+ (Bvect_false REQUEST_WIDTH) c) as HH.
+ rewrite HH; exact EqR.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H.
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; cbn [fst snd].
+ rewrite //= VectorSpec.map_id.
+ rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
+ }
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H.
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; cbn [fst snd].
+ by [].
+ Qed. *)
+
+ Theorem SM_Eq_NFULL (t : nat) (c_state : State_t) (f_req: Request_t)
+ (c_req : Bvector REQUEST_WIDTH) (push : bool) :
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: f_req] -> EqReq f_req c_req -> State_Eq f_state c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R f_state in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM_ c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Proof.
+ destruct (f_state) eqn:Hf_state.
+ { destruct (nat_of_ord c0 == PREA_date - 1) eqn:Hcref_prea; move: Hcref_prea.
+ { destruct r eqn:HR.
+ { apply SM_Eq_1a. }
+ { apply SM_Eq_1b. }
+ }
+ { destruct (c0 + WAIT < PREA_date) eqn:Hcref_service; move: Hcref_service.
+ { destruct r eqn:HR.
+ { apply SM_Eq_2a. }
+ { apply SM_Eq_2b. }
+ }
+ { destruct r eqn:HR.
+ { apply SM_Eq_3a. (* Case 3a: IDLE -> IDLE (empty queue )*) }
+ { apply SM_Eq_3b. (* Case 3b: IDLE -> IDLE (non empty queue) *) }
+ }
+ }
+ }
+ { destruct (nat_of_ord c == OACT_date) eqn:Hact_date.
+ { destruct r eqn:HR.
+ { admit. (* Case 4a : RUNNING -> RUNNING (ACT) (empty queue) *) }
+ { admit. (* Case 4b : RUNNING -> RUNNING (ACT) (non empty queue) *)}
+ }
+ { destruct (nat_of_ord c == OCAS_date) eqn:Hcas_date.
+ { destruct r eqn:HR.
+ { admit. (* Case 5a : RUNNING -> RUNNING (CAS) (empty queue )*) }
+ { admit. (* Case 5b : RUNNING -> RUNNING (CAS) (non-empty queue) *)}
+ }
+ { destruct (nat_of_ord c == WAIT.-1) eqn:Hend_date.
+ { destruct r eqn:HR.
+ { admit. (* Case 6a : RUNNING -> IDLE (empty queue) *) }
+ { admit. (* Case 6b : RUNNING -> IDLE (non empty queue) *)}
+ }
+ { destruct r eqn:HR.
+ { admit. (* Case 7a : RUNNING -> RUNNING (empty queue) *) }
+ { admit. (* Case 7b : RUNNING -> RUNNING (non empty queue) *) }
+ }
+ }
+ }
+ }
+ { destruct (nat_of_ord c == OREF_date) eqn:Href_date.
+ { destruct r eqn:HR.
+ { admit. (* Case 8a REFRESHING -> REFRESHING (REF) *)}
+ { admit. (* Case 8b REFRESHING -> REFRESHING (REF) *)}
+ }
+ { destruct (nat_of_ord c == OENDREF_date) eqn:Hendref_date.
+ { destruct r eqn:HR.
+ { admit. (* Case 9a REFRESHING -> IDLE*) }
+ { admit. (* Case 9b REFRESHING -> IDLE *) }
+ }
+ { destruct r eqn:HR.
+ { admit. (* Case 10a REFRESHING -> REFRESHING (REF) *) }
+ { admit. (* Case 10b REFRESHING -> REFRESHING (REF) *) }
+ }
+ }
+ }
+ Admitted.
+
+End EquivalenceProof.
\ No newline at end of file
diff --git a/framework/CavaDRAM/CavaFIFOREF.v b/framework/CavaDRAM/CavaFIFOREF.v
index c1ba51b..7f067eb 100644
--- a/framework/CavaDRAM/CavaFIFOREF.v
+++ b/framework/CavaDRAM/CavaFIFOREF.v
@@ -1,6 +1,8 @@
-From CavaDRAM Require Import CavaReqQueue CavaSM CavaCommonInstances.
-From DRAM Require Import FIFO.
-From Coq Require Import BinaryString HexString NArith.
+Set Warnings "-notation-overridden,-parsing".
+From CavaDRAM Require Import CavaReqQueue CavaCommonInstances Util CavaSystem Memory.
+From CoqDRAM Require Import FIFO.
+From Coq Require Import BinaryString HexString NArith Program.Equality.
+From Cava Require Import Cava.
Section CavaFIFOREF.
@@ -9,13 +11,24 @@ Section CavaFIFOREF.
Context {SYS_CFG : System_configuration}.
Context {FIFO_CFG : FIFO_configuration}.
+ Import CavaReqQueue.DataNotation.
+ Open Scope data_scope.
+
Definition STATE_WIDTH := 2.
- Definition COUNTER_WIDTH :=
- if (powerOfTwo WAIT) then Nat.log2 WAIT else (Nat.log2 WAIT + 1).
+ Definition COUNTER_WIDTH := Nat.log2 (WAIT).
+ Definition CNT_WAIT := Vec.bitvec_literal (#D (N.of_nat (WAIT - 1)) | COUNTER_WIDTH).
+ Definition CNT_ACT := Vec.bitvec_literal (#D (N.of_nat ACT_date) | COUNTER_WIDTH).
+ Definition CNT_CAS := Vec.bitvec_literal (#D (N.of_nat CAS_date) | COUNTER_WIDTH).
+ Definition CNT_NIL := Vec.bitvec_literal (#D (N.of_nat 0) | COUNTER_WIDTH).
+ Definition CNT_NIL_VEC := Vector.const false COUNTER_WIDTH.
+
+ (* Definition COUNTER_REF_WIDTH := Nat.log2 (WAIT_REF). *)
Definition COUNTER_REF_WIDTH :=
- if (powerOfTwo PREA_date) then Nat.log2 PREA_date else (Nat.log2 PREA_date + 1).
+ if Nat.pow 2 (Nat.log2 (PREA_date + (WAIT - 1))) == (PREA_date + (WAIT - 1))
+ then Nat.log2 (PREA_date + (WAIT - 1))
+ else (Nat.log2 (PREA_date + (WAIT - 1))).+1.
Definition state := Vec Bit STATE_WIDTH.
Definition counter := Vec Bit COUNTER_WIDTH.
@@ -26,9 +39,6 @@ Section CavaFIFOREF.
Definition counter_t := signal counter.
Definition counter_ref_t := signal counter_ref.
- Import CavaSM.DataNotation.
- Open Scope data_scope.
-
Definition NOP_VEC := (#B "11111" | DRAM_CMD_WIDTH).
Definition NOP := Vec.bitvec_literal NOP_VEC.
Definition PRE_VEC := (#B "10010" | DRAM_CMD_WIDTH).
@@ -44,14 +54,8 @@ Section CavaFIFOREF.
Definition REF_VEC := (#B "10001" | DRAM_CMD_WIDTH).
Definition REF := Vec.bitvec_literal REF_VEC.
- Definition CNT_WAIT := Vec.bitvec_literal (#D (N.of_nat (WAIT - 1)) | COUNTER_WIDTH).
- Definition CNT_ACT := Vec.bitvec_literal (#D (N.of_nat ACT_date) | COUNTER_WIDTH).
- Definition CNT_CAS := Vec.bitvec_literal (#D (N.of_nat CAS_date) | COUNTER_WIDTH).
- Definition CNT_NIL := Vec.bitvec_literal (#D (N.of_nat 0) | COUNTER_WIDTH).
- Definition CNT_NIL_VEC := Vector.const false COUNTER_WIDTH.
-
Definition CNT_REF_WAIT := Vec.bitvec_literal (#D (N.of_nat (WAIT - 1)) | COUNTER_REF_WIDTH).
- Definition CNT_REF_PREA := Vec.bitvec_literal (#D (N.of_nat PREA_date) | COUNTER_REF_WIDTH).
+ Definition CNT_REF_PREA := Vec.bitvec_literal (#D (N.of_nat (PREA_date - 1)) | COUNTER_REF_WIDTH).
Definition CNT_REF_REF := Vec.bitvec_literal (#D (N.of_nat REF_date) | COUNTER_REF_WIDTH).
Definition CNT_REF_END := Vec.bitvec_literal (#D (N.of_nat END_REF_date) | COUNTER_REF_WIDTH).
Definition CNT_REF_NIL := Vec.bitvec_literal (#D (N.of_nat 0) | COUNTER_REF_WIDTH).
@@ -176,15 +180,6 @@ Section CavaFIFOREF.
mux_ref_sel <- or2 (t3,t4) ;;
mux2 mux_ref_sel (mux_idle_run_out,STATE_REF).
- Definition Update_e (input : state_t * empty_t * counter_t * counter_ref_t) :
- cava (empty_t) := let '(s,e,_,cref) := input in
- s_idle <- Sidle s ;;
- c_service <- CrefPREA_lt cref ;;
- ne <- inv e ;;
- t0 <- and2 (c_service,ne) ;;
- mux_sel <- and2 (s_idle,t0) ;;
- mux2 mux_sel (zero,one).
-
Definition Update_c (input : state_t * empty_t * counter_t * counter_ref_t) :
cava (counter_t) := let '(s,e,c,cref) := input in
s_idle <- Sidle s ;;
@@ -214,35 +209,39 @@ Section CavaFIFOREF.
crefp1 <- incrN cref ;;
mux2 mux2_sel (crefp1,CNT_REF_NIL).
- Definition Update : Circuit
+ Definition Update_ : Circuit
(state_t * empty_t * counter_t * counter_ref_t)
- (state_t * empty_t * counter_t * counter_ref_t) :=
+ (state_t * counter_t * counter_ref_t) :=
Comb (fun '(s,e,c,cref) =>
s' <- Update_s (s,e,c,cref) ;;
- e' <- Update_e (s,e,c,cref) ;;
c' <- Update_c (s,e,c,cref) ;;
cref' <- Update_cref (s,e,c,cref) ;;
- ret (s',e',c',cref')
+ ret (s',c',cref')
).
- Definition FIFOSM : Circuit
- (signal Bit * request_t) (signal Bit * command_t * request_t) :=
- let pop_init : combType (Bit) := false in
+ Definition FIFOSM_ : Circuit
+ (signal Bit * signal (Vec Bit REQUEST_WIDTH))
+ (signal Bit * signal (Vec Bit DRAM_CMD_WIDTH) * signal (Vec Bit REQUEST_WIDTH)) :=
let s_init : combType (state) := STATE_IDLE_VEC in
let cnt_init : combType (counter) := CNT_NIL_VEC in
let cref_init : combType (counter_ref) := CNT_REF_NIL_VEC in
- LoopInit pop_init ( (* Rp, Rd, p *)
- RequestQueue >==> (* full, data, empty *)
- LoopInit s_init ( (* full, data, empty, s *)
- LoopInit cnt_init ( (* full, data, empty, s, cnt *)
- LoopInit cref_init ( (* full, data, empty, s, cnt, cref *)
- Comb (fun '(full,data,empty,s,c,cref) => ret (full,s,empty,c,cref,(s,empty,c,cref,data)))
- >==> Second (NextCR) >==>
- Comb (fun '(full,s,e,c,cref,cr) => ret (full,cr,s,e,c,cref,(s,e,c,cref,cr)))
- >==> Second (CmdGen) >==>
- Comb (fun '(full,cr,s,e,c,cref,cmd) => ret (full,cmd,cr,(s,e,c,cref)))
- >==> Second (Update) >==>
- Comb (fun '(full,cmd,cr,(ns,np,nc,ncref)) => ret (full,cmd,cr,np,ns,nc,ncref)))))).
+ LoopInit s_init ( (* Rp, Rd, s *)
+ LoopInit cnt_init ( (* Rp, Rd, s, cnt *)
+ LoopInit cref_init ( (* Rp, Rd, s, cref, cref *)
+ Comb (fun '(Rp,Rd,s,cnt,cref) =>
+ s_idle <- Sidle s ;;
+ c_service <- CrefPREA_lt cref ;;
+ pop <- and2 (s_idle,c_service) ;;
+ ret(s,cnt,cref,(Rp,Rd,pop))
+ ) >==>
+ Second (RequestQueue') >==>
+ Comb (fun '(s,c,cref,(full,data,empty)) => ret (full,s,empty,c,cref,(s,empty,c,cref,data)))
+ >==> Second (NextCR) >==>
+ Comb (fun '(full,s,e,c,cref,cr) => ret (full,cr,s,e,c,cref,(s,e,c,cref,cr)))
+ >==> Second (CmdGen) >==>
+ Comb (fun '(full,cr,s,e,c,cref,cmd) => ret (full,cmd,cr,(s,e,c,cref)))
+ >==> Second (Update_) >==>
+ Comb (fun '(full,cmd,cr,(ns,nc,ncref)) => ret (full,cmd,cr,ns,nc,ncref))))).
End CavaFIFOREF.
@@ -256,18 +255,32 @@ Section SimCodeGen.
Program Instance FIFO_CFG : FIFO_configuration := {
(* orig: 65 *)
- WAIT := 27
+ WAIT := 32;
}.
- Definition sm_interface
- := sequentialInterface "sm_interface"
+ Definition fifo_interface
+ := sequentialInterface "fifo_interface"
"clk" PositiveEdge "rst" PositiveEdge
[mkPort "Rp" Bit; mkPort "Rd" (Vec Bit REQUEST_WIDTH)]
[mkPort "full_o" Bit; mkPort "cmd_o" (Vec Bit DRAM_CMD_WIDTH); mkPort "CR" (Vec Bit REQUEST_WIDTH)].
- Definition sm_netlist := makeCircuitNetlist sm_interface FIFOSM.
+ Definition sm_netlist := makeCircuitNetlist fifo_interface FIFOSM_.
- (* Import CavaSM.DataNotation.
+ (* Compute circuit_state memqueue'.
+ Compute circuit_state RequestQueue'.
+ Compute circuit_state FIFOSM_.
+
+ Compute circuit_state NextCR. *)
+
+ (* Compute circuit_state FIFOSM. *)
+
+ (* Compute circuit_state memqueue'. *)
+
+ (* Compute circuit_state memqueue'. *)
+ (* Compute circuit_state *)
+
+ (*
+ Import CavaSM.DataNotation.
Open Scope data_scope.
Definition Rsim1_wr := #H "00fe468b00000" | REQUEST_WIDTH.
Definition Rsim1_rd := #H "00fe468b10000" | REQUEST_WIDTH.
@@ -321,7 +334,7 @@ Section SimCodeGen.
Vector.t bool COUNTER_REF_WIDTH))
:= map (fun '(s,e,cnt,cref) => (state2string s,e,Bv2N cnt,Bv2N cref)) e.
- Compute map_queue_out (simulate RequestQueue [
+ (* Compute map_queue_out (simulate RequestQueue [
(true,Rsim1_wr,false);
(true,Rsim1_rd,false)
]).
@@ -338,23 +351,25 @@ Section SimCodeGen.
Compute (map_update_out (simulate Update [
(STATE_IDLE_VEC,true,CNT_NIL,CNT_REF_NIL)
- ])).
+ ])). *)
+ Open Scope seq_scope.
Definition sm_inputs := [
(true,Rsim1_wr);
- (true,Rsim1_rd)
- (* (true,Rsim1_rd); *)
- (* (true,Rsim2_wr); *)
- (* (true,Rsim2_rd); *)
- (* (true,Rsim3_wr); *)
- (* (true,Rsim3_rd) *)
+ (true,Rsim1_rd);
+ (true,Rsim2_wr);
+ (true,Rsim2_rd);
+ (true,Rsim3_wr);
+ (true,Rsim3_rd)
] ++ (repeat (false,REQUEST_NIL) 20).
+ Close Scope seq_scope.
Compute (map_out (simulate FIFOSM sm_inputs)).
Definition expected_out := simulate FIFOSM sm_inputs.
Definition sm_tb :=
- testBench "sm_tb" (sm_interface) sm_inputs expected_out. *)
+ testBench "sm_tb" (sm_interface) sm_inputs expected_out.
+ *)
End SimCodeGen.
\ No newline at end of file
diff --git a/framework/CavaDRAM/CavaReqQueue.v b/framework/CavaDRAM/CavaReqQueue.v
index bf1b465..8200b90 100644
--- a/framework/CavaDRAM/CavaReqQueue.v
+++ b/framework/CavaDRAM/CavaReqQueue.v
@@ -1,22 +1,77 @@
-From Cava Require Export Cava CavaProperties.
-From Coq Require Export Vectors.Fin Bool.Bool Program.Basics BinaryString HexString NArith.
-From CavaDRAM Require Export CavaSystem CavaMemory CavaSubtractor.
+From Cava Require Import Cava CavaProperties.
+From Coq Require Import Vectors.Fin Bool.Bool Program BinaryString HexString NArith.
+From CavaDRAM Require Import CavaSystem CavaMemory CavaSubtractor Memory.
+From mathcomp Require Import ssreflect.
Export Circuit.Notations.
+Module DataNotation.
+Declare Scope data_scope.
+Delimit Scope data_scope with ds.
+Infix "++" := Vector.append.
+Notation "'#B' n '|' w" := (N2Bv_sized w (BinaryString.Raw.to_N n 0)) (at level 0) : data_scope.
+Notation "'#D' n '|' w" := (N2Bv_sized w n) (at level 0) : data_scope.
+Notation "'#H' n '|' w" := (N2Bv_sized w (HexString.Raw.to_N n 0)) (at level 0) : data_scope.
+End DataNotation.
+
Section CavaReqQueue.
Context {CAVA_SYS : CavaSystem}.
Context {signal : SignalType -> Type} {semantics : Cava signal}.
- Definition REQUEST_WIDTH := FE_ADDR_WIDTH + FE_CMD_WIDTH + FE_ID_WIDTH.
+ Import DataNotation.
+ Open Scope data_scope.
+
+ Definition REQUEST_WIDTH := FE_CMD_WIDTH + BANK_ADDR_WIDTH + COL_ADDR_WIDTH + ROW_ADDR_WIDTH.
+ Definition request := Vec Bit REQUEST_WIDTH.
+ Definition request_t := signal request.
+ Definition REQUEST_NIL := Vec.bitvec_literal (#D 0 | REQUEST_WIDTH).
+
+ Definition row_t := signal (Vec Bit ROW_ADDR_WIDTH).
+ Definition col_t := signal (Vec Bit COL_ADDR_WIDTH).
+ Definition bank_t := signal (Vec Bit BANK_ADDR_WIDTH).
+ Definition reqtype_t := signal (Vec Bit FE_CMD_WIDTH).
+
+ Definition StripRequest : Circuit (request_t) (row_t * col_t * bank_t * reqtype_t) :=
+ Comb (fun req => rV <- unpackV req ;;
+ row <- packV (slice_default defaultSignal rV 0 ROW_ADDR_WIDTH) ;; (* bits 0 to 16 *)
+ col <- packV (slice_default defaultSignal rV ROW_ADDR_WIDTH COL_ADDR_WIDTH) ;; (* bits 17 to 26 *)
+ bank <- packV (slice_default defaultSignal rV (ROW_ADDR_WIDTH + COL_ADDR_WIDTH) BANK_ADDR_WIDTH) ;;
+ type <- packV (slice_default defaultSignal rV (ROW_ADDR_WIDTH + COL_ADDR_WIDTH + BANK_ADDR_WIDTH) FE_CMD_WIDTH) ;;
+ ret(row,col,bank,type)
+ ).
+
Definition ADDR_WIDTH := Nat.log2 QUEUE_MAX_SIZE.
+ Lemma ADDR_WIDTH_pos :
+ 0 < ADDR_WIDTH.
+ Proof.
+ unfold ADDR_WIDTH; apply Nat.log2_pos.
+ by specialize QUEUE_MAX_SIZE_GT_1.
+ Qed.
+
+ Definition READ_REQUEST := Vec.bitvec_literal (#D 1 | FE_CMD_WIDTH).
+ Definition WRITE_REQUEST := Vec.bitvec_literal (#D 0 | FE_CMD_WIDTH).
+
+ Definition command := Vec Bit DRAM_CMD_WIDTH.
+ Definition command_t := signal command.
+
+ Definition ReqType (input : signal (Vec Bit FE_CMD_WIDTH)) : cava (signal Bit) :=
+ CavaPrelude.eqb (input,WRITE_REQUEST).
+
+ Definition RequestType (r : request_t) : cava (signal Bit) :=
+ rV <- unpackV r ;;
+ type <- packV (slice_default defaultSignal rV (ROW_ADDR_WIDTH + COL_ADDR_WIDTH + BANK_ADDR_WIDTH) FE_CMD_WIDTH) ;;
+ ReqType type.
+
Definition memqueue :=
memory_dp (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (QUEUE_MAX_SIZE - 1).
- (* A bitvector of length ADDR_WIDTH containing the value of WAIT *)
+ Definition InitMem (n : nat) := Bvect_false REQUEST_WIDTH.
+
+ Definition memqueue' := Memory' (Vec Bit REQUEST_WIDTH) ADDR_WIDTH 1 InitMem.
+
Definition FullVEC := Vec.bitvec_literal (N2Bv_sized ADDR_WIDTH (N.of_nat QUEUE_MAX_SIZE - 1)).
Definition EmptyVec := Vec.bitvec_literal (N2Bv_sized ADDR_WIDTH 0).
@@ -44,43 +99,44 @@ Section CavaReqQueue.
mux2 en (ptr,ptr_p1)
).
- Definition RequestQueue (* this is the right one *)
- : Circuit
- ( signal Bit
- * signal (Vec Bit REQUEST_WIDTH)
- * signal Bit)
- ( signal Bit
- * signal (Vec Bit REQUEST_WIDTH)
- * signal Bit) :=
- let addr_init : combType (Vec Bit (ADDR_WIDTH)) :=
- (Vector.const zero (ADDR_WIDTH)) in
+ Definition req_null := (Vector.const false REQUEST_WIDTH).
+
+ Definition RequestQueue' : Circuit
+ ( signal Bit * signal (Vec Bit REQUEST_WIDTH) * signal Bit) (* pop_i *)
+ ( signal Bit * signal (Vec Bit REQUEST_WIDTH) * signal Bit) (* empty *)
+ := let addr_init : combType (Vec Bit ADDR_WIDTH) := (Vector.const zero ADDR_WIDTH) in
LoopInit addr_init ( (* push_i,data_i,pop_i,wr_ad *)
- LoopInit addr_init ( (* push_i, data_i, pop_i, wr_ad,rd_zadr *)
+ LoopInit addr_init ( (* push_i, data_i, pop_i, wr_ad,rd_adr *)
Comb (fun '(push_i,data_i,pop_i,wr_ad,rd_ad) => ret (push_i,data_i,pop_i,(wr_ad,rd_ad)))
>==> Second (Comb fork2 >==> (Second FullEmptyLogic))
>==> Comb (fun '(push_i, data_i, pop_i, ((wr_ad, rd_ad), (full_o, empty_o))) =>
+ (* Read Enable Logic *)
n_empt <- inv empty_o ;;
rd_en <- and2 (pop_i,n_empt) ;;
- (* can also write if one element will be poped *)
+ (* Write Enable Logic *)
n_full <- inv full_o ;;
t0 <- and2(full_o,rd_en) ;;
t1 <- or2 (t0,n_full) ;;
wr_en <- and2 (push_i,t1) ;;
- ret (full_o,empty_o,wr_ad,wr_en,rd_ad,rd_en,(data_i,wr_ad,rd_ad,wr_en)))
- >==> Second (memqueue)
- >==> Comb (fun '(full_o, empty_o,wr_ad,w_en,r_ad,r_en,data_o) =>
- ret (full_o,data_o,empty_o,((wr_ad,w_en),(r_ad,r_en))))
+ (* Builds the Read Port Vector *)
+ vec_nil <- (Vec.nil (A := (Vec Bit ADDR_WIDTH))) ;;
+ rd_ad_vec <- Vec.cons rd_ad vec_nil ;;
+ (* Returns *)
+ ret (full_o,empty_o,wr_ad,wr_en,rd_ad,rd_en,(rd_ad_vec,(data_i,wr_ad,wr_en))))
+ >==> Second (memqueue')
+ >==> Comb (fun '(full_o,empty_o,wr_ad,w_en,r_ad,r_en,data_o) =>
+ ret (full_o,data_o,empty_o,((wr_ad,w_en),(r_ad,r_en)))
+ )
>==> Second (First (incr_pointr) >==> Second (incr_pointr))
>==> Second (Comb(fork2) >==> First(FullEmptyLogic))
- (* the empty signal is purposely delayed *)
+ (* full is calculated based on the new address values *)
>==> Comb (fun '(full_o,data_o,empty_o,(n_full_o, n_empty_o,(n_wr_ad,n_rd_ad))) =>
- ret (n_full_o,data_o,empty_o,n_wr_ad,n_rd_ad))
- )
- ).
+ ret (n_full_o,data_o,empty_o,n_wr_ad,n_rd_ad)))).
End CavaReqQueue.
Section CodeGeneration.
+
Existing Instance CavaCombinationalNet.
(* Definition queue_interface
diff --git a/framework/CavaDRAM/CavaReqQueueProperties.v b/framework/CavaDRAM/CavaReqQueueProperties.v
new file mode 100644
index 0000000..280751c
--- /dev/null
+++ b/framework/CavaDRAM/CavaReqQueueProperties.v
@@ -0,0 +1,424 @@
+Set Printing Projections.
+Set Warnings "-notation-overridden,-parsing".
+
+From CavaDRAM Require Import CavaReqQueue CavaCommonInstances CavaSubtractor Step CavaSystem Memory Util UtilSM.
+From Coq Require Import Program BinaryString HexString NArith Bool.
+From Cava Require Import Cava CavaProperties Util.Vector Util.Tactics.
+From mathcomp Require Import ssreflect ssrnat ssrbool eqtype fintype ssrZ zify ring.
+
+Section CavaReqQueueProperties.
+
+ Context {signal : SignalType -> Type} {semantics : Cava signal}.
+ (* From Cava *)
+ (* Context {combsemantics : CombinationalSemantics}. *)
+ Existing Instance CombinationalSemantics.
+ (* From CavaDRAM*)
+ Context {CAVA_SYS : CavaSystem}.
+
+ Import Memory.Properties BvectorNotations.
+ Open Scope Bvector_scope.
+
+ Lemma size_nat_qms :
+ N.size_nat (N.of_nat QUEUE_MAX_SIZE - 1) <= Nat.log2 QUEUE_MAX_SIZE.
+ Proof.
+ rewrite N.sub_1_r -Nat2N.inj_pred.
+ apply /leP; apply N.size_nat_le_nat.
+ rewrite QUEUE_MAX_SIZE_PW2.
+ apply /ltP; rewrite ltn_predL; apply /ltP.
+ exact QUEUE_MAX_SIZE_GT_0.
+ Qed.
+
+ Lemma size_nat_qms_sub (a b: Bvector ADDR_WIDTH) :
+ (Bv2N b < Bv2N a)%N ->
+ N.size_nat (N.of_nat QUEUE_MAX_SIZE - (Bv2N a - Bv2N b)) <= ADDR_WIDTH.
+ Proof.
+ intros Hlt; apply /leP.
+ destruct (Bv2N b) eqn:Hb0, (Bv2N a) eqn:Ha0; try done;
+ apply N.size_nat_le; unfold ADDR_WIDTH; rewrite QUEUE_MAX_SIZE_PW2_N; try rewrite N.sub_0_r.
+ { apply N.sub_lt; [ | done].
+ unfold ADDR_WIDTH in a,b.
+ specialize (@Bv2N_upper_bound_nat (Nat.log2 QUEUE_MAX_SIZE) a) as Ha.
+ rewrite QUEUE_MAX_SIZE_PW2 in Ha.
+ rewrite Ha0 in Ha.
+ apply to_nat_lt_of_nat in Ha.
+ apply N.le_lteq; left; exact Ha.
+ }
+ { apply N.sub_lt.
+ 2: apply N.lt_add_lt_sub_l; rewrite N.add_0_r; lia.
+ unfold ADDR_WIDTH in a,b.
+ specialize (@Bv2N_upper_bound_nat (Nat.log2 QUEUE_MAX_SIZE) a) as Ha.
+ rewrite QUEUE_MAX_SIZE_PW2 in Ha.
+ specialize (@Bv2N_upper_bound_nat (Nat.log2 QUEUE_MAX_SIZE) b) as Hb.
+ rewrite QUEUE_MAX_SIZE_PW2 in Hb.
+ apply to_nat_lt_of_nat in Ha,Hb; rewrite Ha0 in Ha; rewrite Hb0 in Hb.
+ apply N.le_sub_le_add_l; rewrite N.add_comm.
+ apply N.lt_trans with (m := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) (n := N.pos p0)
+ (p := N.add (N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) (N.pos p)) in Ha as H;
+ [ apply N.le_lteq; by left | ].
+ apply N.lt_add_pos_r; done.
+ }
+ Qed.
+
+ Definition fullQueue (wa ra : Bvector ADDR_WIDTH) : bool :=
+ let waN := Bv2N wa in
+ let raN := Bv2N ra in
+ let qms := N.sub (N.of_nat QUEUE_MAX_SIZE) 1 in
+ if (raN <= waN)%nat then ((N.sub (Bv2N wa) (Bv2N ra)) =? qms)%N
+ else (((N.add qms 1) - (raN - waN))%N =? qms)%N.
+
+ Lemma N2Bv_sized_queuemax_neq0 :
+ N2Bv_sized ADDR_WIDTH 0 <> N2Bv_sized ADDR_WIDTH (N.of_nat QUEUE_MAX_SIZE - 1).
+ Proof.
+ apply N2Bv_sized_neq_iff; unfold ADDR_WIDTH.
+ { rewrite /N.size_nat /Nat.log2 //=. }
+ { rewrite -N.pred_sub -Nat2N.inj_pred.
+ apply /leP; apply N.size_nat_le_nat.
+ rewrite QUEUE_MAX_SIZE_PW2; apply /leP.
+ rewrite ltn_predL; apply /leP.
+ exact QUEUE_MAX_SIZE_GT_0. }
+ { rewrite -N.pred_sub -Nat2N.inj_pred.
+ specialize QUEUE_MAX_SIZE_DIFF_0 as HH.
+ move: HH => /N.eqb_spec HH.
+ by apply /N.eqb_spec.
+ }
+ Qed.
+
+ (* -------------- Proofs about FullEmptyLogic ------------------------------- *)
+ Lemma FEL_emp_equiv (c : circuit_state FullEmptyLogic) wra rda :
+ wra = rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,true)).
+ Proof.
+ intros H; eapply ex_intro.
+ cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
+ cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply pair_equal_spec; split; [ | by rewrite H CavaPreludeProperties.eqb_refl ].
+ rewrite inv_correct; cbv [bind].
+ rewrite fullAdder_cin; cbv [unpackV]; simpl_ret.
+ destruct (one) eqn:Hone; [ | discriminate].
+ destruct ((Bv2N rda) <= (Bv2N wra)) eqn:Hleq;
+ [ | by rewrite H leqnn in Hleq ].
+ assert (N.sub (Bv2N wra) (Bv2N rda) = N0); [ by rewrite H N.sub_diag | ].
+ rewrite H0 !bitvec_literal_correct.
+ set (N := N.sub _ _).
+ specialize N2Bv_sized_queuemax_neq0 as H2.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@ADDR_WIDTH CAVA_SYS))
+ (x := N2Bv_sized ADDR_WIDTH 0) (y := N2Bv_sized ADDR_WIDTH N) as HH.
+ by apply HH in H2.
+ Qed.
+
+ Lemma FEL_nemp_wrap1_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
+ let wrap1 := N2Bv_sized ADDR_WIDTH (Bv2N wra + 1) in
+ wra = rda -> exists c' f', step FullEmptyLogic c (wrap1,rda) = (c',(f',false)).
+ Proof.
+ intros; repeat eapply ex_intro; unfold wrap1.
+ cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
+ cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply CavaPreludeProperties.eqb_neq; rewrite H.
+ apply N2Bv_sized_plusone_diff; unfold ADDR_WIDTH.
+ specialize QUEUE_MAX_SIZE_GT_1 as HQ; apply Nat.log2_pos in HQ.
+ by move: HQ => /ltP HQ.
+ Qed.
+
+ Lemma FEL_nemp_NF_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
+ ~~ (fullQueue wra rda) ->
+ wra <> rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,false)).
+ Proof.
+ intros NF H; eapply ex_intro.
+ rewrite /fullQueue in NF.
+ cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
+ cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply pair_equal_spec; split; [ | by apply CavaPreludeProperties.eqb_neq ].
+ rewrite bitvec_literal_correct.
+ rewrite fullAdder_cin; destruct (one) eqn:Hbug; try discriminate; clear Hbug.
+ cbv [unpackV].
+ destruct (_ <= _) eqn:Hleq; apply CavaPreludeProperties.eqb_neq.
+ { set (xx := N.sub (Bv2N wra) (Bv2N rda)); fold xx in NF.
+ set (yy := N.sub (N.of_nat QUEUE_MAX_SIZE) 1); fold yy in NF.
+ assert (N.size_nat xx <= ADDR_WIDTH);
+ [ unfold xx; apply size_nat_sub_leq; lia | ].
+ assert (N.size_nat yy <= ADDR_WIDTH);
+ [ unfold ADDR_WIDTH, yy; by apply size_nat_qms | ].
+ apply N2Bv_sized_neq_iff; try done; lia.
+ }
+ { rewrite {3}/ADDR_WIDTH QUEUE_MAX_SIZE_PW2; apply N2Bv_sized_neq_iff.
+ { assert (Bv2N rda > Bv2N wra); [ lia | ].
+ by apply size_nat_qms_sub.
+ }
+ { unfold ADDR_WIDTH; by apply size_nat_qms. }
+ specialize add_1_sub1 with (x := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) as HH.
+ rewrite HH in NF; [ | exact QUEUE_MAX_SIZE_GT_0_N]; lia.
+ }
+ Qed.
+
+ Lemma FEL_NF_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
+ ~~ (fullQueue wra rda) ->
+ exists c' e', step FullEmptyLogic c (wra,rda) = (c',(false,e')).
+ Proof.
+ intros NF; unfold fullQueue in NF; repeat eapply ex_intro.
+ cbv [FullEmptyLogic]; cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [reflexivity | ].
+ apply pair_equal_spec; split; [ | reflexivity ].
+ cbv [dropr subtractor EqFULL FullVEC unpackV]; simpl_ident.
+ destruct ((Bv2N rda) <= (Bv2N wra)) eqn:Hleq;
+ destruct (one) eqn:Hone; try discriminate;
+ rewrite fullAdder_cin Hleq;
+ apply CavaPreludeProperties.eqb_neq; move: NF => /eqP NF.
+ { set (xx := N.sub (Bv2N wra) (Bv2N rda)); fold xx in NF.
+ set (yy := N.sub (N.of_nat QUEUE_MAX_SIZE) 1); fold yy in NF.
+ assert (N.size_nat xx <= ADDR_WIDTH);
+ [ unfold xx; apply size_nat_sub_leq; lia | ].
+ assert (N.size_nat yy <= ADDR_WIDTH);
+ [ unfold ADDR_WIDTH, yy; by apply size_nat_qms | ].
+ apply N2Bv_sized_neq_iff; try done; lia.
+ }
+ { rewrite {3}/ADDR_WIDTH QUEUE_MAX_SIZE_PW2; apply N2Bv_sized_neq_iff.
+ { assert (Bv2N rda > Bv2N wra) as H; [ lia | ].
+ by apply size_nat_qms_sub.
+ }
+ { unfold ADDR_WIDTH; by apply size_nat_qms. }
+ specialize add_1_sub1 with (x := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) as HH; lia.
+ }
+ Qed.
+
+ (* ------------------------------------------------------------------ *)
+ Lemma incrn_pointr_true_equiv (c : circuit_state incr_pointr) ad :
+ step incr_pointr c (ad,true) =
+ (tt,N2Bv_sized ADDR_WIDTH (Bv2N ad + 1)).
+ Proof.
+ cbv [incr_pointr step] ; by simpl_ident.
+ Qed.
+
+ Lemma incrn_pointr_false_equiv (c : circuit_state incr_pointr) ad :
+ step incr_pointr c (ad,false) = (tt,ad).
+ Proof.
+ cbv [incr_pointr step] ; by simpl_ident.
+ Qed.
+
+ Definition get_mem_RequestQueue (c : circuit_state RequestQueue') :=
+ let '(_,(_,(_,_, _,memqueue_state,_,_,_,_,_),_)) := c in memqueue_state.
+
+ Definition get_addr_RequestQueue (c : circuit_state RequestQueue') :=
+ let '(_,(_,(_,_, _,_,_,_,_,_,rda),wra)) := c in (wra,rda).
+
+ Definition get_memcells (s : circuit_state memqueue') :=
+ let '(_,memcells_state,_) := s in memcells_state.
+
+ Definition get_memcells_RequestQueue (c : circuit_state RequestQueue') :=
+ get_memcells (get_mem_RequestQueue c).
+
+ Lemma test {W} (t : combType (Vec Bit W)) : forall n : nat,
+ (N.to_nat (Bv2N t) =? n)%N = false ->
+ indexConst (decode true t) n = constant false.
+
+ (* ----------------------- Proofs about the Queue ---------------------- *)
+ Lemma Queue_NF_WR_fst (c : circuit_state RequestQueue') c_req :
+ let '(wra,rda) := get_addr_RequestQueue c in
+ let S := get_memcells_RequestQueue c in
+ let wra_idx := N.to_nat (Bv2N wra) in
+ let memcells_spec := Cells_read true wra_idx c_req S in
+ ~~ (fullQueue wra rda) -> exists c',
+ ((Cells_data (get_memcells_RequestQueue c') = memcells_spec) /\
+ (fst (get_addr_RequestQueue c')) = (N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) /\
+ (snd (get_addr_RequestQueue c')) = rda) /\
+ fst (step RequestQueue' c (true,c_req,false)) = c'.
+ Proof.
+ simpl in c; destruct_products.
+ unfold get_addr_RequestQueue; intros Hfull; eapply ex_intro; split; [ | reflexivity].
+ set (p := step RequestQueue' _ _).
+ cbv [RequestQueue' LoopInit fork2] in p.
+ cbn [step] in p; cbn [fst snd] in p; simpl_ret_H p; cbv [fst snd] in p.
+ specialize FEL_NF_equiv with (c := (u17, (u19, u20, u18), u16))
+ (rda := t0) (wra := t) as H; apply H in Hfull; clear H.
+ destruct Hfull as [cs_FEL' [empty_o Hfull]].
+ unfold p; clear p; rewrite Hfull.
+ cbn [fst snd bind inv and2 or2]; fast_simpl_bool.
+ rewrite (surjective_pairing (step memqueue' _ _)).
+ rewrite incrn_pointr_true_equiv incrn_pointr_false_equiv.
+ rewrite (surjective_pairing (step FullEmptyLogic _ _)).
+ set (fel := step FullEmptyLogic _ _).
+ split.
+ { simpl in fel; unfold fel; cbv [snd fst].
+ cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ cbv [memqueue' Memory' mem_write mem_read]; cbn [step fst snd]; simpl_ident; cbv [fst snd].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ cbv [fst snd].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ specialize @Cells_matchX with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
+ (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
+ (S0 := c) (we := true) (wd := c_req) (wa := (N.to_nat (Bv2N t))) as HH.
+ rewrite -HH; [reflexivity | | ].
+ { intros.
+ rewrite /indexConst; simpl_ident.
+ rewrite /decode; simpl_ident.
+ induction ADDR_WIDTH.
+
+ rewrite /decode_.
+ admit.
+ }
+ { rewrite /indexConst; simpl_ident.
+ rewrite /decode; simpl_ident.
+ admit.
+ }
+ }
+ split; by simpl.
+ Admitted. *)
+
+ Lemma Queue_WR_NF_NE_fst (c : circuit_state RequestQueue') c_req pop :
+ let '(wra,rda) := get_addr_RequestQueue c in
+ let S := get_memcells_RequestQueue c in
+ let wra_idx := N.to_nat (Bv2N wra) in
+ let memcells_spec := Cells_read true wra_idx c_req S in
+ ~~ (fullQueue wra rda) -> wra <> rda -> exists c',
+ ((Cells_data (get_memcells_RequestQueue c') = memcells_spec) /\
+ (fst (get_addr_RequestQueue c')) = (N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) /\
+ (snd (get_addr_RequestQueue c')) = (if pop then (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1)) else rda)) /\
+ fst (step RequestQueue' c (true,c_req,pop)) = c'.
+ Admitted.
+ (* Proof.
+ simpl in c; destruct_products.
+ unfold get_addr_RequestQueue; intros Hfull Hdiff; eapply ex_intro; split; [ | reflexivity].
+ set (p := step RequestQueue' _ _).
+ cbv [RequestQueue' LoopInit fork2] in p.
+ cbn [step] in p; cbn [fst snd] in p; simpl_ret_H p; cbv [fst snd] in p.
+ specialize FEL_nemp_NF_equiv with (c := (u17, (u19, u20, u18), u16))
+ (rda := t0) (wra := t) as H; apply H in Hfull; clear H; [ | done].
+ destruct Hfull as [cs_FEL' Hfull].
+ unfold p; clear p; rewrite Hfull.
+ cbn [fst snd bind inv and2 or2]; fast_simpl_bool.
+ rewrite (surjective_pairing (step memqueue' _ _)).
+ rewrite incrn_pointr_true_equiv.
+ rewrite incrn_pointr_true_equiv.
+ rewrite (surjective_pairing (step FullEmptyLogic _ _)).
+ set (fel := step FullEmptyLogic _ _).
+ split.
+ { simpl in fel; unfold fel; cbv [snd fst].
+ cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ cbv [memqueue' Memory' mem_write mem_read]; cbn [step fst snd]; simpl_ident; cbv [fst snd].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ cbv [fst snd].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ fold mem_cells_.
+ specialize @Cells_matchX with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
+ (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
+ (S0 := c) (we := true) (wd := c_req) (wa := (N.to_nat (Bv2N t))) as HH.
+ rewrite -HH; [reflexivity | | ].
+ { intros.
+ rewrite /indexConst; simpl_ident.
+ rewrite /decode; simpl_ident.
+ admit.
+ }
+ { rewrite /indexConst; simpl_ident.
+ rewrite /decode; simpl_ident.
+ admit.
+ }
+ }
+ split; by simpl.
+ Admitted. *)
+
+ Lemma Queue_WR_NF_E_fst (c : circuit_state RequestQueue') c_req pop :
+ let '(wra,rda) := get_addr_RequestQueue c in
+ let S := get_memcells_RequestQueue c in
+ let wra_idx := N.to_nat (Bv2N wra) in
+ let memcells_spec := Cells_read true wra_idx c_req S in
+ ~~ (fullQueue wra rda) -> wra = rda -> exists c',
+ ((Cells_data (get_memcells_RequestQueue c') = memcells_spec) /\
+ (fst (get_addr_RequestQueue c')) = (N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) /\
+ (snd (get_addr_RequestQueue c')) = rda) /\
+ fst (step RequestQueue' c (true,c_req,pop)) = c'.
+ Admitted.
+
+ (* Ignoring the full signal because it just goes to the output *)
+ Lemma Queue_WR_E_snd (c : circuit_state RequestQueue') c_req pop :
+ let '(wra,rda) := get_addr_RequestQueue c in
+ let S := get_memcells_RequestQueue c in
+ let rda_idx := N.to_nat (Bv2N rda) in
+ let wra_idx := N.to_nat (Bv2N wra) in
+ let memcells' := Cells_read true wra_idx c_req S in
+ let mem_val := nth_default (req_null) rda_idx memcells' in
+ wra = rda -> exists f',
+ snd (step RequestQueue' c (true,c_req,pop)) = (f',mem_val,true).
+ Admitted.
+ (* simpl in c; destruct_products; rename t0 into rda, t into wra.
+ autounfold with get_state; intros.
+ cbv [RequestQueue' LoopInit fork2]; simpl_ret; cbn [step fst snd].
+ eapply FEL_emp_equiv with (c := (u17,(u19,u20,u18), u16)) in H as HH.
+ destruct HH as [cs_FEL HH]; rewrite HH.
+ cbn [fst snd bind inv and2 or2].
+ rewrite (surjective_pairing (step memqueue' (u12,c,u11) _)).
+ cbv [fst snd]; fast_simpl_bool.
+ rewrite incrn_pointr_true_equiv if_same incrn_pointr_false_equiv; clear HH.
+ eapply FEL_nemp_wrap1_equiv with (c := (u4, (u6, u7, u5), u3)) in H as HH.
+ destruct HH as [cs_FELL [full_o HH]]; rewrite HH; clear HH.
+ eapply ex_intro.
+ apply pair_equal_spec; split; [ | reflexivity ].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ cbv [memqueue' Memory' mem_write mem_read].
+ cbn [step fst snd]; simpl_ret.
+ rewrite (surjective_pairing (step (mem_cells _ _ _ _) c _)).
+ specialize @Cells_data_match with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
+ (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
+ (S0 := c) (we := true) (wa := (N.to_nat (Bv2N wra))) (wd := c_req) as HH.
+ rewrite -HH.
+ { cbv [indexAt indexConst defaultCombValue].
+ cbv [unpackV bind]; simpl_ret.
+ rewrite nth_0; simpl; unfold req_null.
+ reflexivity.
+ }
+ all: admit.
+ Admitted. *)
+
+ Lemma Queue_WR_NF_NE_snd (c : circuit_state RequestQueue') c_req pop :
+ let '(wra,rda) := get_addr_RequestQueue c in
+ let S := get_memcells_RequestQueue c in
+ let rda_idx := N.to_nat (Bv2N rda) in
+ let wra_idx := N.to_nat (Bv2N wra) in
+ let memcells' := Cells_read true wra_idx c_req S in
+ let mem_val := nth_default (req_null) rda_idx memcells' in
+ ~~ (fullQueue wra rda) -> wra <> rda -> exists full_o,
+ snd (step RequestQueue' c (true,c_req,pop)) = (full_o,mem_val,false).
+ Admitted.
+ (* simpl in c; destruct_products; rename t0 into rda, t into wra.
+ autounfold with get_state; intros.
+ cbv [RequestQueue' LoopInit fork2]; simpl_ret; cbn [step fst snd].
+ apply FEL_nemp_NF_equiv with (c := (u17,(u19,u20,u18), u16)) in H as HH; [ | done].
+ destruct HH as [cs_FEL HH]; rewrite HH.
+ cbn [fst snd bind inv and2 or2]; fast_simpl_bool.
+ rewrite (surjective_pairing (step memqueue' (u12,c,u11) _)).
+ cbv [fst snd]; fast_simpl_bool.
+ rewrite incrn_pointr_true_equiv.
+ rewrite (surjective_pairing (step incr_pointr u9 _)).
+ (* rewrite incrn_pointr_false_equiv; clear HH. *)
+ (* The second logic doesn't really matter much *)
+ rewrite (surjective_pairing (step FullEmptyLogic _ _)).
+ eapply ex_intro.
+ apply pair_equal_spec; split; [ | reflexivity].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ destruct_pair_let.
+ cbv [memqueue' Memory' mem_write mem_read].
+ cbn [step fst snd]; simpl_ret.
+ rewrite (surjective_pairing (step (mem_cells _ _ _ _) c _)); clear HH.
+ specialize @Cells_data_match with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
+ (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
+ (S0 := c) (we := true) (wa := (N.to_nat (Bv2N wra))) (wd := c_req) as HH.
+ rewrite -HH //=.
+ all: admit.
+ Admitted. *)
+
+End CavaReqQueueProperties.
\ No newline at end of file
diff --git a/framework/CavaDRAM/CavaSMExtraction.v b/framework/CavaDRAM/CavaSMExtraction.v
index f856dd3..e9e8a0f 100644
--- a/framework/CavaDRAM/CavaSMExtraction.v
+++ b/framework/CavaDRAM/CavaSMExtraction.v
@@ -1,6 +1,6 @@
Set Warnings "-notation-overridden,-parsing".
-Require Import CavaFIFOREF CavaTDMREF.
+Require Import CavaFIFOREF.
Require Import Extraction.
Require Import ExtrHaskellBasic.
@@ -18,6 +18,8 @@ Cd "fifo_gencode".
Recursive Extraction Library CavaFIFOREF.
Cd "..".
+(*
Cd "tdm_gencode".
Recursive Extraction Library CavaTDMREF.
-Cd "..".
+Cd "..".
+*)
diff --git a/framework/CavaDRAM/CavaSubtractor.v b/framework/CavaDRAM/CavaSubtractor.v
index 890d2de..8416e03 100644
--- a/framework/CavaDRAM/CavaSubtractor.v
+++ b/framework/CavaDRAM/CavaSubtractor.v
@@ -1,7 +1,12 @@
-Require Export Cava.Cava.
-Require Export Cava.CavaProperties.
+Require Import Cava.Cava.
+Require Import Cava.CavaProperties.
+Require Import Cava.Util.Vector.
-From CavaDRAM Require Import CavaSystem.
+From CavaDRAM Require Import CavaSystem UtilSM.
+From mathcomp Require Import ssreflect ssrnat ssrbool seq eqtype.
+From mathcomp Require Import ssrZ zify ring.
+From Coq Require Import NArith.
+From CoqDRAM Require Import Util.
Import Circuit.Notations.
@@ -10,28 +15,103 @@ Section CavaSubtractor.
Context {signal : SignalType -> Type} {semantics : Cava signal}.
Definition subtractor {n : nat}
- (inputs : signal (Vec Bit n) * signal (Vec Bit n))
- : cava (signal (Vec Bit n) * signal Bit)
- := let '(a,b) := inputs in
- not_b <- Vec.inv b ;;
- aV <- unpackV a ;;
- bV <- unpackV not_b ;;
- col fullAdder one (vcombine aV bV).
+ (inputs : signal (Vec Bit n) * signal (Vec Bit n))
+ : cava (signal (Vec Bit n) * signal Bit)
+ := let '(a,b) := inputs in
+ not_b <- Vec.inv b ;;
+ aV <- unpackV a ;;
+ bV <- unpackV not_b ;;
+ col fullAdder one (vcombine aV bV).
Definition Subtractor {n : nat}
- : Circuit (signal (Vec Bit n) * (* N-bit Minued *)
- signal (Vec Bit n)) (* N-bit Subtrahend *)
- (signal (Vec Bit n) * (* N-bit Difference*)
- signal Bit)
+ : Circuit _ (signal (Vec Bit n) * signal Bit)
:= Comb subtractor.
- Check addC.
+End CavaSubtractor.
- Definition SubtractorAddC {n : nat}
- (inputs : signal (Vec Bit n) * signal (Vec Bit n)) :
- cava (signal (Vec Bit n) * signal Bit)
- := let '(a,b) := inputs in
- not_b <- Vec.inv b ;;
- addC (a,not_b,one).
+Section CavaSubtractorProperties.
-End CavaSubtractor.
+ Lemma case1 (x y : N) (z : nat) :
+ N.to_nat x < z ->
+ N.to_nat y < z ->
+ (y < x) = false ->
+ let t := N.of_nat z in
+ (2 * (t - (y - x) - 1) + 1)%N =
+ (2 * t - (2 * y + 1 - (2 * x + 1)) - 1)%N.
+ Proof.
+ lia.
+ Qed.
+
+ Lemma case2 (x y : N) (z : nat) :
+ N.to_nat x < z ->
+ N.to_nat y < z ->
+ (y <= x) = false ->
+ let t := N.of_nat z in
+ (2 * (t - (y - x)) + 1)%N =
+ (2 * t - (2 * y - (2 * x + 1)))%N.
+ Proof.
+ lia.
+ Qed.
+
+ Lemma case3 (x y : N) (z : nat) :
+ N.to_nat x < z ->
+ N.to_nat y < z ->
+ (y < x) = false ->
+ let t := N.of_nat z in
+ (2 * (t - (y - x) - 1) + 1)%N =
+ (2 * t - (2 * y + 1 - 2 * x))%N.
+ Proof.
+ lia.
+ Qed.
+
+ Lemma case4 (x y : N) (z : nat) :
+ N.to_nat x < z ->
+ N.to_nat y < z ->
+ (y < x) = false ->
+ let t := N.of_nat z in
+ (2 * (t - (y - x) - 1) + 1)%N =
+ (2 * t - (2 * y - 2 * x) - 1)%N.
+ Proof.
+ lia.
+ Qed.
+
+ Lemma fullAdder_cin {n} (x y : Vector.t bool n) cin:
+ let xN := Bv2N x in
+ let yN := Bv2N y in
+ let out := if cin
+ then (if (yN <= xN)%nat then (xN - yN)%N else ((N.of_nat (Nat.pow 2 n)) - (yN - xN))%N)
+ else (if (yN < xN)%nat then (xN - yN - 1)%N else ((N.of_nat (Nat.pow 2 n)) - (yN - xN) - 1)%N) in
+ fst (col fullAdder cin (vcombine x (Vector.map negb y))) = N2Bv_sized n out.
+ Proof.
+ intros out; unfold out; clear out.
+ revert x y cin.
+ induction n; intros;
+ [ apply Vector.case0 with (v:=x); apply Vector.case0 with (v:=y);
+ destruct cin; reflexivity | ].
+ rewrite col_step fullAdder_correct; cbn [fst snd].
+ rewrite (Vector.eta x) (Vector.eta y); simpl; rewrite IHn; clear IHn;
+ destruct (Vector.hd x) eqn:Hx, (Vector.hd y) eqn:Hy, cin eqn:Hcin; simpl;
+ repeat match goal with
+ | |- context [?y <= ?x] =>
+ let H := fresh "x" in destruct (y <= x) eqn:H
+ | |- context [?y < ?x] =>
+ let H := fresh "x" in destruct (y < x) eqn:H
+ end;
+ set xx := Bv2N (Vector.tl x); set yy := Bv2N (Vector.tl y); fold xx yy in x0, x1.
+ all: try (rewrite -N2Bv_sized_double || rewrite -N2Bv_sized_succ_double); apply f_equal.
+ all: try (rewrite Nat.add_0_r;
+ match goal with
+ | |- context [Nat.pow 2 ?n] => set z := Nat.pow 2 n
+ end; rewrite of_nat_add_double).
+ all: try (rewrite !N.double_spec); try (rewrite !N.succ_double_spec); try lia.
+ all: try (rewrite !N.succ_double_spec in x1); try (rewrite !N.double_spec in x1).
+ all: try (contradict x1; lia);
+ specialize (@Bv2N_upper_bound_nat n (Vector.tl x)) as Hxb; fold xx in Hxb;
+ specialize (@Bv2N_upper_bound_nat n (Vector.tl y)) as Hyb; fold yy in Hyb.
+ all: try apply case1; try done.
+ all: try apply case2; try done.
+ all: try apply case3; try done.
+ all: try apply case4; try done.
+ Qed.
+
+End CavaSubtractorProperties.
diff --git a/framework/CavaDRAM/CavaSubtractorProperties.v b/framework/CavaDRAM/CavaSubtractorProperties.v
index ed4d0e4..471d25e 100644
--- a/framework/CavaDRAM/CavaSubtractorProperties.v
+++ b/framework/CavaDRAM/CavaSubtractorProperties.v
@@ -1,7 +1,7 @@
Require Import CavaSubtractor.
Require Import Coq.micromega.Lia.
-From DRAM Require Import Util.
+From CoqDRAM Require Import Util.
Section CavaSubtractorProperties.
diff --git a/framework/CavaDRAM/CavaSystem.v b/framework/CavaDRAM/CavaSystem.v
index 0e3bfa5..f487878 100644
--- a/framework/CavaDRAM/CavaSystem.v
+++ b/framework/CavaDRAM/CavaSystem.v
@@ -1,3 +1,4 @@
+Set Warnings "-notation-overridden,-parsing".
Require Import Coq.NArith.NArith.
From mathcomp Require Import ssreflect ssrnat ssrbool seq eqtype.
@@ -6,11 +7,23 @@ Section CavaSystem.
Class CavaSystem := {
DRAM_CMD_WIDTH : nat;
- FE_ADDR_WIDTH : nat;
- FE_CMD_WIDTH : nat;
- FE_ID_WIDTH : nat;
+
+ (* FE_ID_WIDTH : nat; *)
+ (* FE_ADDR_WIDTH : nat; *)
+ ROW_ADDR_WIDTH : nat; (* 17 *)
+ COL_ADDR_WIDTH : nat; (* 10 *)
+ BANK_ADDR_WIDTH : nat; (* 4 *)
+ FE_CMD_WIDTH : nat; (* 1 *)
+
QUEUE_MAX_SIZE : nat;
- QUEUE_MAX_SIZE_GT_0 : 0 < QUEUE_MAX_SIZE ;
+ (* Constrint for easing proofs *)
+ QUEUE_MAX_SIZE_PW2 : Nat.pow 2 (Nat.log2 QUEUE_MAX_SIZE) = QUEUE_MAX_SIZE;
+ QUEUE_MAX_SIZE_PW2_N : N.pow 2 (N.of_nat (Nat.log2 QUEUE_MAX_SIZE)) = N.of_nat QUEUE_MAX_SIZE;
+ (* Two versions of the same *)
+ QUEUE_MAX_SIZE_GT_0 : (0 < QUEUE_MAX_SIZE)%coq_nat ;
+ QUEUE_MAX_SIZE_GT_0_N : (0 < N.of_nat QUEUE_MAX_SIZE) ;
+ QUEUE_MAX_SIZE_GT_1 : (1 < QUEUE_MAX_SIZE)%coq_nat ;
+ QUEUE_MAX_SIZE_DIFF_0 : (N0 <> N.of_nat (QUEUE_MAX_SIZE.-1))
}.
End CavaSystem.
\ No newline at end of file
diff --git a/framework/CavaDRAM/CavaTDMREF.v b/framework/CavaDRAM/CavaTDMREF.v
index 3cd89e8..27d5a29 100644
--- a/framework/CavaDRAM/CavaTDMREF.v
+++ b/framework/CavaDRAM/CavaTDMREF.v
@@ -1,6 +1,8 @@
-From CavaDRAM Require Import CavaReqQueue CavaSM CavaCommonInstances.
-From DRAM Require Import TDM.
+Set Warnings "-notation-overridden,-parsing".
+From CavaDRAM Require Import CavaReqQueue CavaCommonInstances CavaSystem.
+From CoqDRAM Require Import TDM.
From Coq Require Import BinaryString HexString NArith.
+From Cava Require Import Cava.
Section CavaTDMREF.
@@ -8,20 +10,15 @@ Section CavaTDMREF.
Context {CAVA_SYS : CavaSystem}.
(* From Cava *)
Context {signal : SignalType -> Type} {semantics : Cava signal}.
- (* From DRAM *)
+ (* From CoqDRAM *)
Context {SYS_CFG : System_configuration} {TDM_CFG : TDM_configuration}.
Definition NR := BANKS.
Definition STATE_WIDTH := 2.
- Definition SLOT_WIDTH :=
- if (powerOfTwo NR) then Nat.log2 NR else (Nat.log2 NR + 1).
-
- Definition COUNTER_WIDTH :=
- if (powerOfTwo SL) then Nat.log2 SL else (Nat.log2 SL + 1).
-
- Definition COUNTER_REF_WIDTH :=
- if (powerOfTwo PREA_date) then Nat.log2 PREA_date else (Nat.log2 PREA_date + 1).
+ Definition SLOT_WIDTH := Nat.log2 NR.
+ Definition COUNTER_WIDTH := Nat.log2 SL.
+ Definition COUNTER_REF_WIDTH := Nat.log2 PREA_date.
Definition state := Vec Bit STATE_WIDTH.
Definition slot := Vec Bit SLOT_WIDTH.
@@ -34,7 +31,7 @@ Section CavaTDMREF.
Definition counter_t := signal counter.
Definition counter_ref_t := signal counter_ref.
- Import CavaSM.DataNotation.
+ Import CavaReqQueue.DataNotation.
Open Scope ds.
Definition SLOT_SN := Vec.bitvec_literal (#D (N.of_nat (SN - 1)) | SLOT_WIDTH).
@@ -116,10 +113,10 @@ Section CavaTDMREF.
CavaPrelude.eqb (input,SLOT_SN).
(* Cuts FE_ID_WIDTH to be just the SLOT_WIDTH lsb *)
- Definition RequestId : Circuit
+ (* Definition RequestId : Circuit
(request_t) (signal (Vec Bit SLOT_WIDTH)) := Comb (fun r =>
rV <- unpackV r ;;
- packV (slice_default defaultSignal rV 0 SLOT_WIDTH)).
+ packV (slice_default defaultSignal rV 0 SLOT_WIDTH)). *)
(* Will not depend on the slot *)
Definition NextCR : Circuit
@@ -144,6 +141,7 @@ Section CavaTDMREF.
ret (mux2_out,mux2_out)
)).
+ (*
Definition CmdGen : Circuit
(state_t * empty_t * counter_t * counter_ref_t * request_t) (command_t) :=
Comb (fun '(s,e,c,cref,req) =>
@@ -173,7 +171,8 @@ Section CavaTDMREF.
t1 <- and2 (c_prea',cz);;
pre_mux_sel <- and2 (t0,t1) ;;
mux2 pre_mux_sel (act_mux_out,PRE)
- ).
+ ).
+ *)
(* Will not depend on the slot *)
Definition Update_s (input : state_t * empty_t * counter_t * counter_ref_t) :
@@ -201,17 +200,6 @@ Section CavaTDMREF.
mux_ref_sel <- or2 (t3,t4) ;;
mux2 mux_ref_sel (mux_idle_run_out,STATE_REF).
- Definition Update_e (input : state_t * empty_t * counter_t * counter_ref_t) :
- cava (empty_t) := let '(s,e,c,cref) := input in
- s_idle <- Sidle s ;;
- c_service <- CrefPREA_lt cref ;;
- ne <- inv e ;;
- cz <- CeqZ c ;;
- t0 <- and2 (c_service,ne) ;;
- t1 <- and2 (s_idle,cz) ;;
- mux_sel <- and2 (t0,t1) ;;
- mux2 mux_sel (zero,one).
-
Definition Update_c (input : state_t * empty_t * counter_t * counter_ref_t) :
cava (counter_t) := let '(_,_,c,_) := input in
c_sl <- CeqSL c ;;
@@ -240,14 +228,13 @@ Section CavaTDMREF.
Definition Update : Circuit
(state_t * slot_t * empty_t * counter_t * counter_ref_t)
- (state_t * slot_t * empty_t * counter_t * counter_ref_t) :=
+ (state_t * slot_t * counter_t * counter_ref_t) :=
Comb (fun '(s,sl,e,c,cref) =>
s' <- Update_s (s,e,c,cref) ;;
sl' <- Update_slot (s,sl,e,c,cref) ;;
- e' <- Update_e (s,e,c,cref) ;;
c' <- Update_c (s,e,c,cref) ;;
cref' <- Update_cref (s,e,c,cref) ;;
- ret (s',sl',e',c',cref')
+ ret (s',sl',c',cref')
).
Definition Idx {W A} n
@@ -279,17 +266,17 @@ Section CavaTDMREF.
end.
(* A 1:N 1-bit demultiplexer *)
- Fixpoint demux_bit N : Circuit
- (signal Bit * signal (Vec Bit SLOT_WIDTH)) (signal (Vec Bit N)) :=
+ Fixpoint demux_bit W N : Circuit
+ (signal Bit * signal (Vec Bit W)) (signal (Vec Bit N)) :=
match N with
| 0 => Comb (fun '(_,_) => Vec.const zero 0)
| S n => Comb (fun '(Rp,sel) =>
- let i := (#D (N.of_nat (NR - (n + 1))) | SLOT_WIDTH) in
+ let i := (#D (N.of_nat (NR - (n + 1))) | W) in
i_vec <- Vec.bitvec_literal i ;;
eq_sel <- CavaPrelude.eqb(sel,i_vec) ;;
t <- mux2 eq_sel (zero,Rp) ;;
ret (t,(Rp,sel)))
- >==> Second (demux_bit n) >==>
+ >==> Second (demux_bit W n) >==>
Comb (fun '(t,t0) => Vec.cons t t0)
end.
@@ -311,42 +298,72 @@ Section CavaTDMREF.
ret (f,d,e)
).
+ (* push, pop, bank, slot, request -> slot, push_vec, req_vec, pop_vec *)
Definition DemuxInputs : Circuit
- (signal Bit * request_t * signal Bit * slot_t)
+ (signal Bit * signal Bit * request_t * bank_t * slot_t )
(slot_t * signal (Vec Bit NR) * signal(Vec request NR) * signal (Vec Bit NR)) :=
- Comb (fun '(Rp,Rd,p,sl) => ret (p,sl,Rp,(Rd)))
- >==> Second (Comb (fork2) >==> First (RequestId) >==> Second (repeatF (A := request) NR)) >==>
- (* Uses slot to demux the pop signal into the queues *)
- Comb (fun '(p,sl,Rp,(id,Rd_vec)) => ret (sl,Rp,Rd_vec,id,(p,sl)))
- >==> Second (demux_bit NR) >==>
- (* Uses FE_ID to demux the push signal into the queques *)
- Comb (fun '(sl,Rp,Rd_vec,id,pop_vec) => ret (sl,Rd_vec,pop_vec,(Rp,id)))
- >==> Second (demux_bit NR) >==>
- (* Applies the demux'd vectors into the queues *)
- Comb (fun '(sl,Rd_vec,pop_vec,Rp_vec) => ret (sl,(Rp_vec,Rd_vec,pop_vec)))
- >==> Second (Queues NR) >==>
- Comb (fun '(sl,(f_vec,d_vec,e_vec)) => ret (sl,f_vec,d_vec,e_vec)).
-
- Definition DemuxInputs' : Circuit
- (signal Bit * request_t * signal Bit * slot_t)
- (signal (Vec Bit NR) * signal(Vec request NR) * signal (Vec Bit NR)) :=
- Comb (fun '(Rp,Rd,p,sl) => ret (p,sl,Rp,(Rd)))
- >==> Second (Comb (fork2) >==> First (RequestId) >==> Second (repeatF (A := request) NR)) >==>
- (* Uses slot to demux the pop signal into the queues *)
- Comb (fun '(p,sl,Rp,(id,Rd_vec)) => ret (sl,Rp,Rd_vec,id,(p,sl)))
- >==> Second (demux_bit NR) >==>
- (* Uses FE_ID to demux the push signal into the queques *)
- Comb (fun '(sl,Rp,Rd_vec,id,pop_vec) => ret (sl,Rd_vec,pop_vec,(Rp,id)))
- >==> Second (demux_bit NR) >==>
- (* Applies the demux'd vectors into the queues *)
- Comb (fun '(sl,Rd_vec,pop_vec,Rp_vec) => ret (Rp_vec,Rd_vec,pop_vec)).
-
- Definition MuxQueues : Circuit
- (signal Bit * request_t * signal Bit * slot_t)
- (signal Bit * request_t * empty_t) :=
- DemuxInputs >==>
- Comb (fun '(sl,f_vec,d_vec,e_vec) => ret (f_vec,d_vec,e_vec,sl)) >==>
- mux_sigs NR.
+ Comb (fun '(push,pop,req,bank,sl) => ret (push,pop,bank,sl,(req)))
+ (* Repeats req to all queues *)
+ >==> Second (repeatF (A := request) NR)
+ (* Use the slot to demux the pop signal into the queus*)
+ >==> Comb (fun '(push,pop,bank,sl,req_vec) => ret (sl,push,bank,req_vec,(pop,sl)))
+ >==> Second (demux_bit SLOT_WIDTH NR)
+ (* Use the bank to demux the push signal into the queues *)
+ >==> Comb (fun '(sl,push,bank,req_vec,pop_vec) => ret (sl,req_vec,pop_vec,(push,bank)))
+ >==> Second (demux_bit BANK_ADDR_WIDTH NR)
+ (* Return *)
+ >==> Comb (fun '(sl,req_vec,pop_vec,push_vec) => ret (sl,push_vec,req_vec,pop_vec)).
+
+ Definition TDMSM_v3 : Circuit
+ (signal Bit * request_t) (signal Bit * command_t * request_t) :=
+ let slot_init : combType (slot) := SLOT_NIL_VEC in
+ let s_init : combType (state) := STATE_IDLE_VEC in
+ let cnt_init : combType (counter) := CNT_NIL_VEC in
+ let cref_init : combType (counter_ref) := CNT_REF_NIL_VEC in
+ Second (Comb (fork2) >==> Second (StripRequest)) >==>
+ Comb (fun '(push,(req,(_,_,bank,type))) => ret (push,bank,type,req)) >==>
+ LoopInit slot_init (
+ LoopInit s_init (
+ LoopInit cnt_init (
+ LoopInit cref_init ( (* push, bank, type, slot, s, cnt, cref *)
+ Comb (fun '(push,bank,type,req,sl,s,cnt,cref) =>
+ s_idle <- Sidle s ;;
+ c_service <- CrefPREA_lt cref ;;
+ pop <- and2 (s_idle,c_service) ;;
+ ret(type,req,s,cnt,cref,(push,pop,req,bank,sl)))
+ >==> Second (DemuxInputs)
+ >==> Comb (fun '(type,req,s,cnt,cref,(sl,push_vec,reqin_vec,pop_vec)) =>
+ ret (type,req,s,cnt,cref,sl,(push_vec,reqin_vec,pop_vec)))
+ >==> Second (Queues NR)
+ >==> Comb (fun '(type,req,s,cnt,cref,sl,(full_vec,data_vec,empty_vec)) =>
+ ret (one,NOP,REQUEST_NIL,SLOT_NIL,STATE_IDLE,CNT_NIL,CNT_REF_NIL)))))).
+
+ (* Definition TDMSM_ : Circuit
+ (signal Bit * request_t) (signal Bit * command_t * request_t) :=
+ let slot_init : combType (slot) := SLOT_NIL_VEC in
+ let s_init : combType (state) := STATE_IDLE_VEC in
+ let cnt_init : combType (counter) := CNT_NIL_VEC in
+ let cref_init : combType (counter_ref) := CNT_REF_NIL_VEC in
+ LoopInit slot_init (
+ LoopInit s_init (
+ LoopInit cnt_init (
+ LoopInit cref_init ( (* Rp, Rd, sl, st, cnt, cref *)
+ Comb (fun '(Rp,Rd,sl,s,cnt,cref) =>
+ s_idle <- Sidle s ;;
+ c_service <- CrefPREA_lt cref ;;
+ pop <- and2 (s_idle,c_service) ;;
+ ret(s,cnt,cref,(Rp,Rd,pop,sl))
+ ) >==>
+ Second (DemuxInputs) >==>
+ Comb (fun '(s,cnt,cref,(sl,f_vec,d_vec,e_vec)) => ret(s,cnt,cref,sl,(f_vec,d_vec,e_vec,sl)))
+ >==> Second (mux_sigs NR) >==> (* s,cnt,cref,sl,(f,d,e) *)
+ Comb (fun '(s,cnt,cref,sl,(full,data,empty)) => ret(full,sl,s,empty,cnt,cref,(s,empty,cnt,cref,data)))
+ >==> Second (NextCR) >==> (*full,sl,s,empty,cnt,cref,cr *)
+ Comb (fun '(full,sl,s,empty,cnt,cref,cr) => ret(full,cr,sl,s,empty,cnt,cref,(s,empty,cnt,cref,cr)))
+ >==> Second (CmdGen) >==>
+ Comb (fun '(full,cr,sl,s,empty,cnt,cref,cmd) => ret(full,cmd,cr,(s,sl,empty,cnt,cref)))
+ >==> Second (Update_) >==>
+ Comb (fun '(full,cmd,cr,(ns,nsl,nc,ncref)) => ret (full,cmd,cr,nsl,ns,nc,ncref)))))).
Definition TDMSM : Circuit
(signal Bit * request_t) (signal Bit * command_t * request_t) :=
@@ -370,7 +387,7 @@ Section CavaTDMREF.
>==> Second (CmdGen) >==>
Comb (fun '(full,cr,sl,s,empty,cnt,cref,cmd) => ret(full,cmd,cr,(s,sl,empty,cnt,cref)))
>==> Second (Update) >==>
- Comb (fun '(full,cmd,cr,(ns,nsl,np,nc,ncref)) => ret (full,cmd,cr,np,nsl,ns,nc,ncref))))))).
+ Comb (fun '(full,cmd,cr,(ns,nsl,np,nc,ncref)) => ret (full,cmd,cr,np,nsl,ns,nc,ncref))))))). *)
End CavaTDMREF.
@@ -381,10 +398,13 @@ Section CavaTDMREFsim.
Existing Instance SYS_CFG.
Program Instance TDM_CFG : TDM_configuration := {
- SL := 25;
+ SL := 32;
SN := 8
}.
+ (* 2 banks -> slot_width *)
+ (* Compute circuit_state TDMSM. *)
+
Definition tdm_interface
:= sequentialInterface "tdm_interface"
"clk" PositiveEdge "rst" PositiveEdge
@@ -392,8 +412,10 @@ Section CavaTDMREFsim.
[mkPort "full_o" Bit; mkPort "cmd_o" (Vec Bit DRAM_CMD_WIDTH); mkPort "CR" (Vec Bit REQUEST_WIDTH)].
Definition tdm_netlist := makeCircuitNetlist tdm_interface TDMSM.
-
- (* Import CavaSM.DataNotation.
+
+ (*
+
+ Import CavaSM.DataNotation.
Open Scope data_scope.
Definition Rsim1_wr := #H "00fe468b00000" | REQUEST_WIDTH.
Definition Rsim1_rd := #H "00fe468b10000" | REQUEST_WIDTH.
@@ -403,6 +425,36 @@ Section CavaTDMREFsim.
Definition Rsim3_rd := #H "033f91a210001" | REQUEST_WIDTH.
Definition Rsim5_wr := #H "00467f2300007" | REQUEST_WIDTH.
+ Definition test (e : seq (bool * Bvector REQUEST_WIDTH * bool)) :=
+ map (fun '(f,d,e) => (f,HexString.of_N (Bv2N d),e)) e.
+
+ Compute (test (simulate RequestQueue [
+ (* wra = 0, rda = 0*)
+ (true,Rsim1_wr,false);
+ (* wra = 1, rda = 0*)
+ (false,Rsim2_wr,true);
+ (* wra = 1 ,rda = 1 *)
+ (true,Rsim1_wr,false)
+ ])).
+
+ Compute simulate memqueue [
+ (* Rsim1_wr @0 *)
+ (Rsim1_wr,(#D 0 | ADDR_WIDTH), (#D 0 | ADDR_WIDTH),true);
+ (* Reads Rsim_wr @0 *)
+ ((#D 1 | REQUEST_WIDTH),(#D 0 | ADDR_WIDTH), (#D 0 | ADDR_WIDTH),true);
+ (* Reads R1 @0 *)
+ ((#D 2 | REQUEST_WIDTH),(#D 0 | ADDR_WIDTH), (#D 0 | ADDR_WIDTH),true)
+ ].
+
+ (*
+ Definition Rsim1_wr := #H "00fe468b00000" | REQUEST_WIDTH.
+ Definition Rsim1_rd := #H "00fe468b10000" | REQUEST_WIDTH.
+ Definition Rsim2_wr := #H "027f234500001" | REQUEST_WIDTH.
+ Definition Rsim2_rd := #H "027f234510001" | REQUEST_WIDTH.
+ Definition Rsim3_wr := #H "033f91a200001" | REQUEST_WIDTH.
+ Definition Rsim3_rd := #H "033f91a210001" | REQUEST_WIDTH.
+ Definition Rsim5_wr := #H "00467f2300007" | REQUEST_WIDTH.
+
Definition SM_out := (bool * Vector.t bool DRAM_CMD_WIDTH * Vector.t bool REQUEST_WIDTH)%type.
Definition cmd2string (cmd : Vector.t bool DRAM_CMD_WIDTH) : string :=
@@ -470,4 +522,6 @@ Section CavaTDMREFsim.
Compute (map_out (simulate TDMSM sm_inputs)). *)
+ *)
+
End CavaTDMREFsim.
diff --git a/framework/CavaDRAM/CavaTDMREFProperties.v b/framework/CavaDRAM/CavaTDMREFProperties.v
new file mode 100644
index 0000000..e84159a
--- /dev/null
+++ b/framework/CavaDRAM/CavaTDMREFProperties.v
@@ -0,0 +1,111 @@
+Set Printing Projections.
+Set Warnings "-notation-overridden,-parsing".
+
+From CavaDRAM Require Import CavaTDMREF CavaSM CavaReqQueue CavaCommonInstances CavaSubtractor Step CavaSystem Memory Util UtilSM.
+From CoqDRAM Require Import TDM.
+From Coq Require Import Program BinaryString HexString NArith.
+From Cava Require Import Cava CavaProperties Util.Vector Util.Tactics.
+From mathcomp Require Import fintype ssrZ zify ring.
+
+Section CavaFIFOREFProperties.
+ (* From Cava *)
+ Existing Instance CombinationalSemantics.
+ (* From CavaDRAM*)
+ Context {CAVA_SYS : CavaSystem}.
+ (* From CoqDRAM *)
+ Existing Instance REQESTOR_CFG.
+ Context {SYS_CFG : System_configuration}.
+ Context {TDM_CFG : TDM_configuration}.
+ Context {HAF : HW_Arrival_function_t}.
+ Existing Instance ARBITER_CFG.
+ Existing Instance TDM_implementation.
+
+ Import Memory.Properties BvectorNotations.
+ Open Scope Bvector_scope.
+
+ Definition State_t := circuit_state TDMSM.
+
+ Definition get_state (s : State_t) : combType (CavaTDMREF.state) :=
+ let '(_,(_,(_,_,_,_,_,_,_,_,_,_,_,_,(_,(_,_,st)),_),_)) := s in st.
+
+ Definition get_slot (s : State_t) : combType (Vec Bit SLOT_WIDTH) :=
+ let '(_,(_,(_,_, _,_,_,_,_,_,_,_,_,_,_,slot),_)) := s in slot.
+
+ Definition get_pop (s : State_t) : combType Bit :=
+ let '(_,(_,_,pop)) := s in pop.
+
+ Definition get_cnt (s : State_t) : combType (Vec Bit COUNTER_WIDTH) :=
+ let '(_,(_,(_,_,_,_,_,_,_,_,_,_,_,_,(_,(_,(_,_,cnt),_)),_),_)) := s in cnt.
+
+ Definition get_cref (s : State_t) : combType (Vec Bit COUNTER_REF_WIDTH) :=
+ let '(_,(_,(_,_,_,_,_,_,_,_,_,_,_,_,(_,(_,(_,(_,_,_,_,_,_,_,cref),_),_)),_),_)) := s in cref.
+
+ Definition get_req (s : State_t) : combType (Vec Bit REQUEST_WIDTH) :=
+ let '(_,(_,(_,_,_,_,_,_,_,_,_,_,_,_,(_,(_,(_,(_,(_, (_,req)),_,_,_,_,_,_),_),_)),_),_)) := s in req.
+
+ Definition cnt2Bv (cnt : Counter_t) :=
+ N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)).
+
+ Definition cref2Bv (cref : Counter_ref_t) :=
+ N2Bv_sized COUNTER_REF_WIDTH (N.of_nat (nat_of_ord cref)).
+
+ Definition slot2Bv (slot : Slot_t) :=
+ N2Bv_sized SLOT_WIDTH (N.of_nat (nat_of_ord slot)).
+
+ Definition get_mem (s : State_t) : circuit_state (Queues NR) :=
+ let '(_,(_,(_,_,_,_,_,_,_,mem,_,_,_,_,_,_),_)) := s in mem.
+
+ (* Think about this *)
+ Definition MemPred (P : Requests_t) (mem : circuit_state (Queues NR)) : bool.
+ Admitted.
+
+ Definition EqReq (r : Request_t) (r' : Bvector REQUEST_WIDTH) : bool.
+ Admitted.
+
+ (* Think about EqMem and EqQueues *)
+ Definition State_Eq (fs : TDM_state_t) (cs : State_t) : bool :=
+ let cs_state := get_state cs in
+ let cs_sl := get_slot cs in
+ let cs_cnt := get_cnt cs in
+ let cs_cref := get_cref cs in
+ let cs_mem := get_mem cs in
+ let cs_pop := get_pop cs in
+ let cs_req := get_req cs in
+ match fs with
+ | IDLE sl cnt cref P => (cs_state =? STATE_IDLE_VEC)
+ && (cs_sl =? slot2Bv sl) && (cs_cnt =? cnt2Bv cnt) && (cs_cref =? cref2Bv cref)
+ && (MemPred P cs_mem) && (cs_pop == false)
+ | RUNNING sl cnt cref P r => (cs_state =? STATE_RUN_VEC)
+ && (cs_sl =? slot2Bv sl) && (cs_cnt =? cnt2Bv cnt) && (cs_cref =? cref2Bv cref)
+ && (MemPred P cs_mem) && (cs_pop == (nat_of_ord cnt == 1)) && (EqReq r cs_req)
+ | REFRESHING sl cnt cref P => (cs_state =? STATE_REF_VEC)
+ && (cs_sl =? slot2Bv sl) && (cs_cnt =? cnt2Bv cnt) && (cs_cref =? cref2Bv cref)
+ && (MemPred P cs_mem) && (cs_pop == false)
+ end.
+
+ Theorem TS_Bisimulation (c_req : Bvector REQUEST_WIDTH) :
+ forall c_state t,
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ State_Eq f_state c_state -> EqReq R c_req ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R f_state in
+ exists c_nextstate, (c_nextstate = fst (step TDMSM c_state (true,c_req))) /\
+ State_Eq f_nextstate c_nextstate.
+ Proof.
+ intros c_state t f_state R H Hreq.
+ repeat destruct_pair_let.
+ eapply ex_intro; split; [reflexivity | ].
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rename t4 into cr, t3 into cref, t2 into cnt, t1 into state, t0 into slot, b into pop.
+ unfold State_Eq in H; cbv [get_state get_slot get_cnt get_cref get_pop get_mem] in H.
+ destruct f_state eqn:Hf_state.
+ { move: H => /andP [/andP [/andP [/andP [/andP [EqS EqSlot] EqCnt] EqCref] EqMem] EqPop].
+ apply BVEq_iff_eq in EqS, EqSlot, EqCnt, EqCref; move: EqPop => /eqP EqPop;
+ subst state slot cnt cref pop.
+ cbv [TDMSM LoopInit].
+ cbn [step fst snd]; simpl_ret.
+ admit.
+ }
+ Admitted.
+
+End CavaFIFOREFProperties.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Lib/CavaCounter.v b/framework/CavaDRAM/Lib/CavaCounter.v
index b2f24fa..b261b5a 100644
--- a/framework/CavaDRAM/Lib/CavaCounter.v
+++ b/framework/CavaDRAM/Lib/CavaCounter.v
@@ -15,7 +15,7 @@ Require Export CavaMemory.
Require Export Lia.
Require Export Omega.
-From DRAM Require Export FIFO.
+From CoqDRAM Require Export FIFO.
Section CavaCounter.
diff --git a/framework/CavaDRAM/Lib/CavaFIFO.v b/framework/CavaDRAM/Lib/CavaFIFO.v
index 0a94dcd..af6dd3b 100644
--- a/framework/CavaDRAM/Lib/CavaFIFO.v
+++ b/framework/CavaDRAM/Lib/CavaFIFO.v
@@ -12,7 +12,7 @@ From CavaDRAM Require Export CavaSystem.
From CavaDRAM Require Export CavaMemory.
From CavaDRAM Require Export CavaSubtractor.
-From DRAM Require Export FIFO.
+From CoqDRAM Require Export FIFO.
Infix "++" := Vector.append.
diff --git a/framework/CavaDRAM/Lib/CavaFIFOREFProperties.v b/framework/CavaDRAM/Lib/CavaFIFOREFProperties.v
new file mode 100644
index 0000000..1e336a4
--- /dev/null
+++ b/framework/CavaDRAM/Lib/CavaFIFOREFProperties.v
@@ -0,0 +1,1630 @@
+Set Printing Projections.
+Set Warnings "-notation-overridden,-parsing".
+
+From CavaDRAM Require Import CavaFIFOREF CavaSM CavaReqQueue CavaCommonInstances CavaSubtractor Step CavaSystem Memory Util UtilSM.
+From CoqDRAM Require Import FIFO.
+From Coq Require Import Program BinaryString HexString NArith.
+From Cava Require Import Cava CavaProperties Util.Vector Util.Tactics.
+From mathcomp Require Import fintype ssrZ zify ring.
+
+Section CavaFIFOREFProperties.
+
+ Context {signal : SignalType -> Type} {semantics : Cava signal}.
+ (* From Cava *)
+ Existing Instance CombinationalSemantics.
+ (* From CavaDRAM*)
+ Context {CAVA_SYS : CavaSystem}.
+ (* From CoqDRAM *)
+ Existing Instance REQESTOR_CFG.
+ Context {SYS_CFG : System_configuration}.
+ Context {FIFO_CFG : FIFO_configuration}.
+ Context {HAF : HW_Arrival_function_t}.
+ Existing Instance ARBITER_CFG.
+ Existing Instance FIFO_implementation.
+
+ Import Memory.Properties BvectorNotations.
+ Open Scope Bvector_scope.
+
+ Lemma leq_Nle (a b : N) :
+ leq (nat_of_bin a) (nat_of_bin b) -> (a <= b)%N.
+ Proof.
+ lia.
+ Qed.
+
+ Lemma ltn_Ntn (a b : N) :
+ leq (S (nat_of_bin a)) (nat_of_bin b) -> (a < b)%N.
+ Proof.
+ lia.
+ Qed.
+
+ Lemma log2_eq1_pw2 (n : nat) :
+ Nat.pow 2 (Nat.log2 n) = n ->
+ Nat.log2 n = 1 -> n = 2.
+ Proof.
+ intros. by rewrite H0 in H.
+ Qed.
+
+ Lemma Bv_eq_translation {n} (a b : Bvector n) :
+ (nat_of_bin (Bv2N a) = nat_of_bin (Bv2N b)) ->
+ (Bv2N a = Bv2N b)%N.
+ Proof.
+ lia.
+ Qed.
+
+ Lemma Bv_ltn_translation {n} (a b : Bvector n) :
+ (nat_of_bin (Bv2N a) < nat_of_bin (Bv2N b)) ->
+ (Bv2N a < Bv2N b)%N.
+ Proof.
+ lia.
+ Qed.
+
+ Lemma lt_trans_le (n m p : N):
+ (m < n)%N -> (n < p)%N -> (m + 1 < p)%N.
+ Proof.
+ lia.
+ Qed.
+
+ Lemma to_nat_lt_of_nat (a : N) (n : nat) :
+ N.to_nat a < n -> (a < N.of_nat n)%N.
+ Proof.
+ intros.
+ induction n; [ discriminate | ].
+ rewrite leq_eqVlt in H; move: H => /orP [/eqP H | H].
+ { rewrite -H Nat2N.inj_succ N2Nat.id; by specialize (N.lt_succ_diag_r a). }
+ assert (N.to_nat a < n).
+ { specialize (ltn_add2r 1 (N.to_nat a) n) as S; rewrite !addn1 in S; by rewrite S in H. }
+ apply IHn in H0.
+ apply N.lt_trans with (m := N.of_nat n); [ done | ].
+ rewrite Nat2N.inj_succ; by specialize (N.lt_succ_diag_r (N.of_nat n)).
+ Qed.
+
+ Lemma to_nat_lt_pow a b:
+ N.to_nat a < Nat.pow 2 b -> (a < 2 ^ N.of_nat b)%N.
+ Proof.
+ intros; apply to_nat_lt_of_nat in H.
+ rewrite -Nat2N.inj_pow in H.
+ by simpl (N.of_nat 2) in H.
+ Qed.
+
+ Lemma length_to_list_shiftin {A N} (v : Vector.t A N) (e : A) :
+ Datatypes.length (Vector.to_list (Vector.shiftin e v)) = N + 1.
+ Proof.
+ induction v; [ rewrite //= | ].
+ unfold Vector.shiftin; fold @Vector.shiftin.
+ rewrite to_list_cons cons_length IHv; lia.
+ Qed.
+
+ Lemma last_shiftin {A N} (v : Vector.t A N) (def e : A) :
+ last (Vector.to_list (Vector.shiftin e v)) def = e.
+ Proof.
+ induction v; [ rewrite //= | ].
+ unfold Vector.shiftin; fold @Vector.shiftin.
+ rewrite to_list_cons //=.
+ destruct (Vector.to_list (Vector.shiftin e v)) eqn:Hbug;
+ [ contradict Hbug; induction v; simpl; done | ].
+ done.
+ Qed.
+
+ Lemma Bv2N_upper_bound {n : nat} (bv : Bvector n) :
+ (N.to_nat (Bv2N bv) < (Nat.pow 2 n)).
+ Proof.
+ induction bv; [ by simpl | ]; destruct h; rewrite Bv2N_cons.
+ { rewrite N.succ_double_spec.
+ set z := Bv2N _; fold z in IHbv.
+ rewrite N2Nat.inj_add N2Nat.inj_mul.
+ vm_compute (N.to_nat 1); vm_compute (N.to_nat 2).
+ assert ((2 * N.to_nat z)%coq_nat = (2 * N.to_nat z)%nat); try done; rewrite H; clear H.
+ assert ((2 * N.to_nat z + 1)%coq_nat = (2 * N.to_nat z + 1)%nat); try done; rewrite H; clear H.
+ apply ltn_mul_add1 in IHbv.
+ rewrite Nat.pow_succ_r; [ | apply /leP; by rewrite leq0n ].
+ assert ((2 * (2 ^ n))%coq_nat = (2 * (2 ^ n))%nat); try done; rewrite H; clear H. }
+ { rewrite N.double_spec N2Nat.inj_mul; set z := Bv2N _; fold z in IHbv; vm_compute (N.to_nat 2).
+ assert ((2 * N.to_nat z)%coq_nat = (2 * N.to_nat z)%nat); try done; rewrite H; clear H.
+ have aux : (0 < 2); [ done | ].
+ have H := (ltn_pmul2l aux); rewrite -H in IHbv.
+ rewrite Nat.pow_succ_r; [ | apply /leP; by rewrite leq0n ]; clear H.
+ assert ((2 * (2 ^ n))%coq_nat = (2 * (2 ^ n))%nat); try done; rewrite H; clear H.
+ }
+ Qed.
+
+ Lemma size_nat_sub_leq {n} (a b : Bvector n):
+ (Bv2N b <= Bv2N a)%N ->
+ N.size_nat (Bv2N a - Bv2N b) <= n.
+ Proof.
+ intros; apply /leP; apply N.size_nat_le.
+ specialize (@Bv2N_upper_bound n a) as Ha.
+ specialize (@Bv2N_upper_bound n b) as Hb.
+ destruct (Bv2N b) eqn:Hb0, (Bv2N a) eqn:Ha0; try discriminate.
+ { simpl in *; by apply to_nat_lt_pow. }
+ { rewrite N.sub_0_r; by apply to_nat_lt_pow in Ha. }
+ { by contradict H. }
+ { apply to_nat_lt_pow in Ha,Hb.
+ apply (N.lt_trans (N.pos p0 - N.pos p) (N.pos p0) (2 ^ N.of_nat n)%N); [ | done].
+ apply N.sub_lt; done.
+ }
+ Qed.
+
+ Lemma N2Bv_sized_eq_p1_false {W} (v : Bvector W):
+ W > 0 -> (N2Bv_sized W (Bv2N v + 1) =? v) = false.
+ Proof.
+ intros; apply BVEq_iff_neq.
+ rewrite N.add_1_r.
+ specialize (N2Bv_sized_Bv2N W v) as H0; rewrite -{2}H0.
+ by apply N2Bv_sized_neq_succ.
+ Qed.
+
+ Lemma cons_eq {n} (x : bool) (a b : Vector.t bool n):
+ (x :: a)%vector =? (x :: b)%vector ->
+ BVeq n n a b.
+ Proof.
+ Admitted.
+
+ Lemma Bvector_wrap {W} (v : Bvector W) :
+ W > 0 -> N2Bv_sized W (Bv2N (N2Bv_sized W (Bv2N v + 1)) + 1) =? v ->
+ W = 1.
+ Proof.
+ intros Hpos H.
+ induction v; intros; try discriminate.
+ rewrite ltnS leq_eqVlt in Hpos; move: Hpos => /orP [/eqP Heq | Hpos];
+ [ by subst n | ].
+ apply (IHv) in Hpos as IH; clear IHv.
+ 2: {
+ destruct h; simpl in H; [
+ rewrite N.succ_double_succ N2Bv_sized_double Bv2N_cons N.double_succ_double
+ N2Bv_sized_succ_double N2Bv_sized_Bv2N in H |
+ rewrite N.double_succ_double N2Bv_sized_succ_double Bv2N_cons N.succ_double_succ
+ N2Bv_sized_double N2Bv_sized_Bv2N in H ];
+ apply cons_eq in H;
+ specialize (@N2Bv_sized_eq_p1_false n v) as HH; apply HH in Hpos;
+ by rewrite Hpos in H.
+ }
+ revert H; generalize v; clear v; rewrite IH; intros.
+ simpl in H; destruct h; rewrite (Vector.eta v) in H;
+ specialize (@tl_0 bool v) as H0; rewrite H0 in H;
+ destruct (VectorDef.hd v); simpl in H; discriminate H.
+ Qed.
+
+ (* --------------------------------------------------------------- *)
+ (* Start of FIFO specific proofs *)
+ Lemma N2Bv_sized_queuemax_neq0 :
+ N2Bv_sized ADDR_WIDTH 0 <> N2Bv_sized ADDR_WIDTH (N.of_nat QUEUE_MAX_SIZE - 1).
+ Proof.
+ apply N2Bv_sized_neq_iff; unfold ADDR_WIDTH.
+ { rewrite /N.size_nat /Nat.log2 //=. }
+ { rewrite -N.pred_sub -Nat2N.inj_pred.
+ apply /leP; apply N.size_nat_le_nat.
+ rewrite QUEUE_MAX_SIZE_PW2; apply /leP.
+ rewrite ltn_predL; apply /leP.
+ exact QUEUE_MAX_SIZE_GT_0. }
+ { rewrite -N.pred_sub -Nat2N.inj_pred.
+ specialize QUEUE_MAX_SIZE_DIFF_0 as HH.
+ move: HH => /N.eqb_spec HH.
+ by apply /N.eqb_spec.
+ }
+ Qed.
+
+ Definition mem_cells_ :=
+ mem_cells (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem.
+
+ Lemma shiftin_nth_default {A} (def : A) (a : A) n (v: Vector.t A n) (k1 k2 : nat) (eq: k1 = k2):
+ k1 < n ->
+ nth_default def k1 (Vector.shiftin a v) = nth_default def k2 v.
+ Admitted.
+
+ (* --------------------------------------------------------------- *)
+ (* Solving the memory problem *)
+
+ Lemma nth_cells_read {T W I} (ad : Bvector W) c_req def
+ (c : circuit_state (mem_cells T W (2 ^ W) I)) :
+ nth_default def (N.to_nat (Bv2N ad)) (Cells_read true (N.to_nat (Bv2N ad)) c_req c) = c_req.
+ Admitted.
+
+ Lemma nth_cells_read_ {T W I N} (ad : Bvector (Nat.log2 N)) c_req def
+ (c : circuit_state (mem_cells T W N I)) : N > 0 ->
+ nth_default def (N.to_nat (Bv2N ad)) (Cells_read true (N.to_nat (Bv2N ad)) c_req c) = c_req.
+ Proof.
+ intros Hpos; rewrite nth_default_to_list.
+ induction N; intros; [ discriminate | ].
+ rewrite leq_eqVlt in Hpos; move: Hpos => /orP [/eqP Heq | Hpos].
+ { assert (N = 0); [ lia | ]; clear IHN Heq; subst N.
+ revert ad; rewrite Nat.log2_1; intros.
+ apply Vector.case0 with (v := ad).
+ simpl in c; destruct_products.
+ rewrite /Cells_read //= andb_true_r.
+ }
+ assert (0 < N); [ lia | ]; clear Hpos.
+ simpl in c; destruct_products; rewrite //= andb_true_r.
+ specialize (Nat.log2_succ_or N) as Hor; destruct Hor as [Hor | Hor].
+ { revert ad; rewrite Hor; intros.
+ destruct (Nat.eqb (N.to_nat (Bv2N ad)) N) eqn:HH; set memvec := Cells_read true _ _ _.
+ { assert (N.to_nat (Bv2N ad) = N) as H0; [ lia | ]; clear HH;
+ rewrite H0.
+ specialize (@length_to_list_shiftin (combType T) N memvec c_req) as HH.
+ assert (N = (Datatypes.length (Vector.to_list (Vector.shiftin c_req memvec))) - 1)%coq_nat; [ lia | ].
+ apply nth_last with (d := def) in H1; rewrite H1.
+ by rewrite last_shiftin. }
+ { unfold memvec.
+ specialize (IHN (VectorDef.tl ad) c0); apply IHN in H as IH; clear IHN.
+ rewrite (Vector.eta ad) Bv2N_cons.
+ destruct (Vector.hd ad).
+ { rewrite N2Nat.inj_succ_double //= !Nat.add_0_r.
+ rewrite -nth_tl.
+ set adtl := N.to_nat (Bv2N (VectorDef.tl ad)).
+ fold adtl in IH.
+ admit. }
+ { admit. }
+ Admitted.
+ (*-----------------------------------------------------------------------------------*)
+
+ Lemma memcell_nch (c: circuit_state mem_cells_) (wra rda : Bvector ADDR_WIDTH) c_req def:
+ wra <> rda ->
+ nth_default def (N.to_nat (Bv2N rda)) (Cells_data c) =
+ nth_default def (N.to_nat (Bv2N rda)) (Cells_read true (N.to_nat (Bv2N wra)) c_req c).
+ Admitted.
+
+ (* Need a to be bigger than b *)
+ Lemma size_nat_qms_sub (a b: Bvector ADDR_WIDTH) :
+ (Bv2N b < Bv2N a)%N ->
+ N.size_nat (N.of_nat QUEUE_MAX_SIZE - (Bv2N a - Bv2N b)) <= ADDR_WIDTH.
+ Proof.
+ intros Hlt; apply /leP.
+ destruct (Bv2N b) eqn:Hb0, (Bv2N a) eqn:Ha0; try done;
+ apply N.size_nat_le; unfold ADDR_WIDTH; rewrite QUEUE_MAX_SIZE_PW2_N; try rewrite N.sub_0_r.
+ { apply N.sub_lt; [ | done].
+ unfold ADDR_WIDTH in a,b.
+ specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) a) as Ha.
+ rewrite QUEUE_MAX_SIZE_PW2 in Ha.
+ rewrite Ha0 in Ha.
+ apply to_nat_lt_of_nat in Ha.
+ apply N.le_lteq; left; exact Ha.
+ }
+ { apply N.sub_lt; [ | apply N.lt_add_lt_sub_l; by rewrite N.add_0_r ].
+ unfold ADDR_WIDTH in a,b.
+ specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) a) as Ha.
+ rewrite QUEUE_MAX_SIZE_PW2 in Ha.
+ specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) b) as Hb.
+ rewrite QUEUE_MAX_SIZE_PW2 in Hb.
+ apply to_nat_lt_of_nat in Ha,Hb; rewrite Ha0 in Ha; rewrite Hb0 in Hb.
+ apply N.le_sub_le_add_l; rewrite N.add_comm.
+ apply N.lt_trans with (m := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) (n := N.pos p0)
+ (p := N.add (N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) (N.pos p)) in Ha as H;
+ [ apply N.le_lteq; by left | ].
+ apply N.lt_add_pos_r; done.
+ }
+ Qed.
+
+ Lemma size_nat_qms :
+ N.size_nat (N.of_nat QUEUE_MAX_SIZE - 1) <= Nat.log2 QUEUE_MAX_SIZE.
+ Proof.
+ rewrite N.sub_1_r -Nat2N.inj_pred.
+ apply /leP; apply N.size_nat_le_nat.
+ rewrite QUEUE_MAX_SIZE_PW2.
+ apply /ltP; rewrite ltn_predL; apply /ltP.
+ exact QUEUE_MAX_SIZE_GT_0.
+ Qed.
+
+ Definition State_t := circuit_state FIFOSM.
+
+ Definition get_mem (s : State_t) : circuit_state memqueue' :=
+ let '(_,(_,(_,(_,_,_,memqueue_state,_,_,_,_,_),_),_,_)) := s in memqueue_state.
+
+ Definition get_pop (s : State_t) :=
+ let '(_,(_,_,_,pop)) := s in pop.
+
+ Definition get_st (s : State_t) :=
+ let '(_,(_,_,(_,(_,_,st)),_)) := s in st.
+
+ Definition get_cnt (s : State_t) :=
+ let '(_,(_,_,(_,(_,(_,_,cnt),_)),_)) := s in cnt.
+
+ Definition get_cref (s : State_t) :=
+ let '(_,(_,_,(_,(_,(_,(_,_,_,_,_,_,_,cref),_),_)),_)) := s in cref.
+
+ Definition get_cr (s : State_t) :=
+ let '(_,(_,_,(_,(_,(_,(_,(_,(_,cr)),_,_,_,_,_,_),_),_)),_)) := s in cr.
+
+ Definition get_wra (s : State_t) :=
+ let '(_,(_,(_,_,wra),_,_)) := s in wra.
+
+ Definition get_rda (s : State_t) :=
+ let '(_,(_,(_,(_,_,_,_,_,_,_,_,rda),_),_,_)) := s in rda.
+
+ Definition get_reqqueue (s : State_t) : circuit_state RequestQueue' :=
+ let '(_,(cs_requeue,_,_)) := s in cs_requeue.
+
+ Definition get_mem_RequestQueue (c : circuit_state RequestQueue') :=
+ let '(_,(_,(_,_, _,memqueue_state,_,_,_,_,_),_)) := c in memqueue_state.
+
+ Definition get_addr_RequestQueue (c : circuit_state RequestQueue') :=
+ let '(_,(_,(_,_, _,_,_,_,_,_,rda),wra)) := c in (wra,rda).
+
+ Definition get_memcells (s : circuit_state memqueue') :=
+ let '(_,memcells_state,_) := s in memcells_state.
+
+ Definition get_memcells_RequestQueue (c : circuit_state RequestQueue') :=
+ get_memcells (get_mem_RequestQueue c).
+
+ (* --------------------------Bounding the counter ------------------- *)
+ Lemma cnt_bounded (cnt : Bvector COUNTER_WIDTH) :
+ N.to_nat (Bv2N cnt) < WAIT.
+ Proof.
+ specialize @Bv2N_upper_bound with (bv := cnt) as H.
+ by rewrite /COUNTER_WIDTH WAIT_PW_2 in H.
+ Qed.
+
+ Definition Bv2cnt (cnt : Bvector COUNTER_WIDTH) : Counter_t :=
+ Ordinal (cnt_bounded cnt).
+
+ Definition cnt2Bv (cnt : Counter_t) :=
+ N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)).
+ (* ------------------------------------------------------------------ *)
+
+ (* --------------------------Bounding cref counter ------------------- *)
+ Lemma cref_bounded (cref : Bvector COUNTER_REF_WIDTH) :
+ N.to_nat (Bv2N cref) < WAIT_REF.
+ Proof.
+ specialize @Bv2N_upper_bound with (bv := cref) as H.
+ by rewrite /COUNTER_REF_WIDTH WAIT_REF_PW2 in H.
+ Qed.
+
+ Definition Bv2cref (cnt : Bvector COUNTER_REF_WIDTH) : Counter_ref_t :=
+ Ordinal (cref_bounded cnt).
+
+ Definition cref2Bv (cref : Counter_ref_t) :=
+ N2Bv_sized COUNTER_REF_WIDTH (N.of_nat (nat_of_ord cref)).
+ (* ------------------------------------------------------------------ *)
+
+ Lemma cref_preadate_false (c : Counter_ref_t) :
+ (cref2Bv c =? CNT_REF_PREA) = false <->
+ (nat_of_ord c == PREA_date - 1) = false.
+ Proof.
+ split. {
+ unfold cref2Bv, CNT_REF_PREA; intros.
+ apply BVEq_iff_neq in H; rewrite bitvec_literal_correct in H.
+ apply N2Bv_sized_neq_if in H.
+ apply of_nat_neq in H.
+ by apply /eqP.
+ }
+ { intros.
+ apply BVEq_iff_neq.
+ rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct.
+ apply N2Bv_sized_neq_iff; [ | | move: H => /eqP H; by rewrite Nat2N.inj_iff ];
+ apply /leP; apply N.size_nat_le_nat; unfold COUNTER_REF_WIDTH; apply /leP;
+ rewrite WAIT_REF_PW2; [ by destruct c | specialize WAIT_REF_PREA_date as HH; by lia ].
+ }
+ Qed.
+
+ Lemma cref_preadate_true (c : Counter_ref_t) :
+ (cref2Bv c =? CNT_REF_PREA) = true <->
+ (nat_of_ord c == PREA_date - 1) = true.
+ Proof.
+ split.
+ { unfold cref2Bv, CNT_REF_PREA; intros.
+ apply BVEq_iff_eq in H; rewrite bitvec_literal_correct in H.
+ apply N2Bv_sized_eq_iff in H.
+ { apply Nat2N.inj in H; rewrite H; by apply /eqP. }
+ { apply N.size_nat_le_nat.
+ destruct c; simpl in *; rewrite /COUNTER_REF_WIDTH; apply /ltP.
+ by rewrite WAIT_REF_PW2. }
+ { apply N.size_nat_le_nat; unfold COUNTER_REF_WIDTH.
+ rewrite WAIT_REF_PW2 subn1; apply /ltP.
+ specialize WAIT_REF_PREA_date as HH.
+ apply ltn_trans with (m := PREA_date.-1) in HH; [ exact HH | ].
+ by rewrite ltn_predL PREA_date_pos.
+ }
+ }
+ { intros Href_prea; move: Href_prea => /eqP Href_prea; apply BVEq_iff_eq.
+ rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct; f_equal.
+ by rewrite Href_prea.
+ }
+ Qed.
+
+ Definition fullQueue (wa ra : Bvector ADDR_WIDTH) : bool :=
+ let waN := Bv2N wa in
+ let raN := Bv2N ra in
+ let qms := N.sub (N.of_nat QUEUE_MAX_SIZE) 1 in
+ if (raN <= waN)%nat then ((Bv2N wa - Bv2N ra)%N == qms)
+ else (((N.add qms 1) - (raN - waN))%N == qms).
+
+ Hypothesis HaltIfFull : forall t c,
+ let wra := get_wra c in
+ let rda := get_rda c in
+ if (HW_Arrival_at t != []) then ~~ fullQueue wra rda else true.
+
+ Program Definition EqReq (r : Request_t) (r' : Bvector REQUEST_WIDTH) : bool.
+ Admitted.
+
+ Lemma EqReqNil : EqReq nullreq REQUEST_NIL = true.
+ Admitted.
+
+ Definition EqCmd (f_cmd : Command_kind_t) (c_cmd : Bvector DRAM_CMD_WIDTH) : bool :=
+ match f_cmd with
+ | ACT => (c_cmd =? ACT_VEC)
+ | PRE => (c_cmd =? PRE_VEC)
+ | PREA => (c_cmd =? PREA_VEC)
+ | CRD => (c_cmd =? RD_VEC)
+ | CWR => (c_cmd =? WR_VEC)
+ | REF => (c_cmd =? REF_VEC)
+ | NOP => (c_cmd =? NOP_VEC)
+ end.
+
+ Fixpoint EqQueue (P : Requests_t) (wra rda : Bvector ADDR_WIDTH) :=
+ match P with
+ | [::] => (wra =? rda)
+ | x :: x0 => negb (wra =? rda) && (EqQueue x0 wra (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1)))
+ end.
+
+ Lemma EqQueue_diff_adr r0 r1 wra rda:
+ EqQueue (r0 :: r1) wra rda -> wra <> rda.
+ Proof.
+ simpl; intros; move: H => /andP [Hd H];
+ by move: Hd => /negPf Hd; apply BVEq_iff_neq in Hd.
+ Qed.
+
+ Lemma EqQueue_aux wra rda r0 r1 r:
+ ~~ fullQueue wra rda -> wra <> rda ->
+ EqQueue (r0 :: r1)%SEQ wra rda ->
+ EqQueue ((r0 :: r1)%SEQ ++ [r])%SEQ (N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) rda.
+ Proof.
+ intros NFULL Hadr HQ; rewrite //=.
+ simpl in HQ; move: HQ => /andP [_ HQ].
+ revert HQ Hadr NFULL; generalize wra rda; induction r1; intros; simpl in HQ.
+ { apply /andP; split.
+ { unfold fullQueue in NFULL.
+ move: NFULL; apply contraPN; intros; apply /negP; rewrite negb_involutive.
+ specialize ADDR_WIDTH_pos as Hawp; move: Hawp => /ltP Hawp.
+ destruct (Bv2N rda0 <= _) eqn:Hleq.
+ { apply BVEq_iff_eq in HQ as HQ'; rewrite HQ' in H; clear HQ'.
+ apply Bvector_wrap in H; [ | apply /ltP; exact ADDR_WIDTH_pos ].
+ apply log2_eq1_pw2 in H as H2 ; [ | by rewrite QUEUE_MAX_SIZE_PW2 ]; clear H.
+ rewrite H2; simpl ((N.of_nat 2 - 1)%N); simpl (N.add (Npos _) (Npos _)).
+ apply BVEq_iff_eq in HQ; rewrite HQ Bv2N_N2Bv_sized; [ lia | ].
+ apply /N.ltb_spec0.
+ destruct ((Bv2N rda0 + 1 <? 2 ^ N.of_nat ADDR_WIDTH)%N) eqn:Hcont; [ done | ].
+ move: Hcont => /negP /negP Hcont; rewrite -N.leb_antisym in Hcont.
+ move: Hcont => /N.leb_spec0 Hcont.
+ unfold ADDR_WIDTH in Hcont; rewrite QUEUE_MAX_SIZE_PW2_N in Hcont.
+ rewrite leq_eqVlt in Hleq; move: Hleq => /orP [/eqP Hbug | Hltn].
+ { specialize (@Bv2N_inj ADDR_WIDTH rda0 wra0) as HH.
+ apply Bv_eq_translation in Hbug; apply HH in Hbug; by rewrite Hbug in Hadr. }
+ apply N.le_lteq in Hcont; destruct Hcont as [Hcont0 | Hcont1];
+ specialize (@Bv2N_upper_bound ADDR_WIDTH wra0) as H;
+ apply Bv_ltn_translation in Hltn;
+ apply to_nat_lt_pow in H;
+ rewrite /ADDR_WIDTH QUEUE_MAX_SIZE_PW2_N in H;
+ apply lt_trans_le with (p := N.of_nat QUEUE_MAX_SIZE) in Hltn; try done.
+ { contradict Hcont0; by apply N.lt_asymm. }
+ { contradict Hcont1; apply N.neq_sym; by apply N.lt_neq. }
+ }
+ { apply BVEq_iff_eq in H; rewrite -H Bv2N_N2Bv_sized; [ lia | ].
+ move: Hleq => /negP /negP Hleq; rewrite -ltnNge in Hleq.
+ apply /N.ltb_spec0.
+ destruct ((Bv2N wra0 + 1 <? 2 ^ N.of_nat ADDR_WIDTH)%N) eqn:Hcont; [ done | ].
+ unfold ADDR_WIDTH in Hcont; rewrite QUEUE_MAX_SIZE_PW2_N in Hcont.
+ move: Hcont => /negP /negP Hcont; rewrite -N.leb_antisym in Hcont; move: Hcont => /N.leb_spec0 Hcont.
+ apply N.le_lteq in Hcont; destruct Hcont as [Hcont0 | Hcont1].
+ { (* use rda bound*) admit. (* proof on page 11 of FIFO notebook *) }
+ { specialize (@Bv2N_upper_bound ADDR_WIDTH rda0) as Hu.
+ unfold ADDR_WIDTH in Hu; rewrite QUEUE_MAX_SIZE_PW2 in Hu.
+ assert (QUEUE_MAX_SIZE = N.to_nat (Bv2N wra0 + 1)).
+ { specialize (N2Nat.id (Bv2N wra0 + 1)) as H_; rewrite -H_ in Hcont1.
+ by apply Nat2N.inj in Hcont1. }
+ admit.
+ (* finish proof by rewriting H1 in Hu, which results in
+ (Bv2N rda < Bv2N wra + 1) -> (Bv2N rda <= Bv2N wra), which contradicts
+ Bv2N wra < Bv2N rda *)
+ }
+ }
+ }
+ { simpl; apply BVEq_iff_eq in HQ; apply /andP; split.
+ { admit. (* should be easy *) }
+ { rewrite HQ; by apply BVEq_iff_eq. }
+ }
+ }
+ move: HQ => /andP [neq HQ].
+ specialize (IHr1 wra0 (N2Bv_sized ADDR_WIDTH (Bv2N rda0 + 1))); apply IHr1 in HQ as IH; clear IHr1.
+ 3: {
+ (* Don't know how to prove that *)
+ (* holds logically (page 12 FIFO notebook) *)
+ unfold fullQueue; unfold fullQueue in NFULL.
+ admit.
+ }
+ 2: by move: neq => /negPf neq; apply BVEq_iff_neq in neq.
+ simpl; apply /andP; split.
+ { move: IH => /andP [neq_ IH].
+ admit. (* holds logically (page 12 FIFO notebook )*) }
+ exact IH.
+ Admitted.
+
+ Check nth_default.
+
+ Fixpoint EqMem_ {W} (P : Requests_t) (rda : Bvector W)
+ (memcells_vec : Vector.t (Bvector REQUEST_WIDTH) (Nat.pow 2 W)) : bool :=
+ match P with
+ | [::] => true
+ | x :: x0 =>
+ let nrda := N2Bv_sized W (Bv2N rda + 1) in
+ let s := nth_default REQUEST_NIL (N.to_nat (Bv2N rda)) memcells_vec in
+ (EqReq x s) && (EqMem_ x0 nrda memcells_vec)
+ end.
+
+ Lemma EqMem_rcons r1 (rda wra : Bvector ADDR_WIDTH) c R (c_req : combType (Vec Bit REQUEST_WIDTH)) :
+ EqQueue r1 wra rda ->
+ EqMem_ r1 rda (@Cells_data (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem c) ->
+ EqReq R c_req ->
+ EqMem_ (r1 ++ [R])%SEQ rda (Cells_read true (N.to_nat (Bv2N wra)) c_req c).
+ Proof.
+ intros HQ Mem EqR; fold mem_cells_ in c; rewrite cats1.
+ revert Mem HQ; generalize wra rda; induction r1; intros.
+ { simpl; rewrite andb_true_r; simpl in HQ; apply BVEq_iff_eq in HQ; rewrite HQ.
+ rewrite VectorSpec.map_id.
+ unfold ADDR_WIDTH in wra,rda.
+ specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem
+ rda0 c_req REQUEST_NIL) as HH; rewrite /REQUEST_NIL bitvec_literal_correct //= in HH;
+ unfold mem_cells_ in c; by rewrite HH. }
+ simpl in Mem,HQ; simpl.
+ move: Mem => /andP [EqR_ Mem]; apply /andP; split.
+ { move: HQ => /andP [/negPf Heq HQ];
+ apply BVEq_iff_neq in Heq; rewrite VectorSpec.map_id; rewrite VectorSpec.map_id in EqR_.
+ rewrite -memcell_nch; done.
+ }
+ { move: HQ => /andP [neq HQ].
+ specialize (IHr1 wra0 (N2Bv_sized ADDR_WIDTH (Bv2N rda0 + 1))); apply IHr1; done.
+ }
+ Qed.
+
+ (* Just use the circuit directly <-> circuit does the work directly *)
+ Definition EqMem (P : Requests_t) rda (mem : circuit_state RequestQueue') :=
+ let memcells_vec := Cells_data (get_memcells_RequestQueue mem) in
+ EqMem_ P rda memcells_vec.
+
+ Definition State_Eq (fram_state : FIFO_state_t) (cava_state : State_t) : bool :=
+ let s := get_st cava_state in
+ let c' := get_cnt cava_state in
+ let cref' := get_cref cava_state in
+ let r' := get_cr cava_state in
+ let RQ := get_reqqueue cava_state in
+ let wra := fst (get_addr_RequestQueue RQ) in
+ let rda := snd (get_addr_RequestQueue RQ) in
+ let pop := get_pop cava_state in
+ match fram_state with
+ | IDLE c cref P =>
+ (s =? STATE_IDLE_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
+ (EqQueue P wra rda) && (pop == false)
+ | RUNNING c cref P r =>
+ (s =? STATE_RUN_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
+ (EqQueue P wra rda) && (EqReq r r') && (pop == (c == OCycle0))
+ | REFRESHING cref P =>
+ (s =? STATE_REF_VEC) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
+ (EqQueue P wra rda) && (pop == false)
+ end.
+
+ (* -------------- Proofs about CmdGen ------------------------------- *)
+ Lemma CmdGen_equiv_idle_to_idle (c : circuit_state CmdGen) cnt cref:
+ (cref =? CNT_REF_PREA) = false ->
+ exists c', step CmdGen c (STATE_IDLE_VEC,true,cnt,cref,REQUEST_NIL) =
+ (c',NOP_VEC).
+ Proof.
+ intros H; simpl in c; destruct_products.
+ eapply ex_intro.
+ cbv [CmdGen]; cbn [step fst snd].
+ simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; simpl.
+ cbv [CrefPREA_eq].
+ apply BVEq_iff_neq in H.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply HH in H; rewrite H VectorSpec.map_id; reflexivity.
+ Qed.
+
+ Lemma CrefPREA_lt_CNT_REF_PREA:
+ CrefPREA_lt CNT_REF_PREA = false.
+ Proof.
+ cbv [CrefPREA_lt]; simpl_ident.
+ unfold greaterThanOrEqual; simpl_ident; unfold greaterThanOrEqualBool.
+ apply /negbF.
+ rewrite {1}/CNT_REF_PREA; rewrite !bitvec_literal_correct.
+ apply /N.leb_spec0; rewrite /CNT_REF_PREA /CNT_REF_WAIT !bitvec_literal_correct.
+ rewrite !Bv2N_N2Bv_sized. { apply N.le_add_r. }
+ all: rewrite /COUNTER_REF_WIDTH WAIT_REF_PW_N.
+ all: try apply N_lt_inj.
+ all: specialize WAIT_REF_PREA_date_WAIT as H; lia.
+ Qed.
+
+ Lemma CmdGen_equiv_idle_to_ref (c : circuit_state CmdGen) cnt cref e:
+ (cref =? CNT_REF_PREA) = true ->
+ exists c', step CmdGen c (STATE_IDLE_VEC,e,cnt,cref,REQUEST_NIL) = (c',PREA_VEC).
+ Proof.
+ intros; simpl in c; destruct_products; eapply ex_intro.
+ cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; simpl; rewrite VectorSpec.map_id.
+ apply BVEq_iff_eq in H; subst cref; rewrite CrefPREA_lt_CNT_REF_PREA !VectorSpec.map_id.
+ rewrite andb_false_r; rewrite /CrefPREA_eq.
+ specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ assert (CNT_REF_PREA = CNT_REF_PREA); [done | ]; apply HH in H; by rewrite H.
+ Qed.
+
+ Lemma CrefPREA_lt_CNT_REF_WAIT cref:
+ (cref2Bv cref =? CNT_REF_PREA) = false -> (cref + WAIT < PREA_date) = true ->
+ CrefPREA_lt (cref2Bv cref) = true.
+ Proof.
+ intros Href_prea Href_service.
+ rewrite /CrefPREA_lt; simpl_ident; rewrite /greaterThanOrEqual; simpl_ident.
+ rewrite /greaterThanOrEqualBool /CNT_REF_WAIT /CNT_REF_PREA !bitvec_literal_correct !Bv2N_N2Bv_sized.
+ { destruct (~~ _) eqn:Hbug; [ done | ].
+ apply negbFE in Hbug; move: Hbug => /N.leb_spec0 Hbug.
+ assert (cref + (WAIT - 1) < (PREA_date - 1)).
+ { rewrite addnBA; [ | exact WAIT_pos].
+ rewrite subn1 -ltnS prednK; [ | by rewrite addn_gt0 WAIT_pos orb_true_r ].
+ rewrite subn1 prednK; [ | exact PREA_date_pos].
+ by rewrite Href_service.
+ }
+ move: H => /ltP H; apply N_lt_inj in H.
+ contradict Hbug; apply N.nle_gt; by rewrite -Nat2N.inj_add.
+ }
+ all: unfold COUNTER_REF_WIDTH; rewrite WAIT_REF_PW_N.
+ all: try rewrite -Nat2N.inj_add; apply N_lt_inj; apply /ltP.
+ all: destruct cref; simpl in *; try done.
+ all: specialize WAIT_REF_PREA_date_WAIT; lia.
+ Qed.
+
+ Lemma CmdGen_equiv_idle_to_running (c : circuit_state CmdGen) cnt cref tr:
+ (cref2Bv cref =? CNT_REF_PREA) = false ->
+ (cref + WAIT < PREA_date) = true ->
+ exists c', step CmdGen c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref),tr) = (c',PRE_VEC).
+ Proof.
+ intros; simpl in c; destruct_products; eapply ex_intro.
+ cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; simpl; rewrite !VectorSpec.map_id.
+ rewrite CrefPREA_lt_CNT_REF_WAIT; done.
+ Qed.
+ (* ------------------------------------------------------------------ *)
+
+ (* -------------- Proofs about NextCR ------------------------------- *)
+ Lemma NextCR_equiv (c : circuit_state NextCR) cnt cref tr:
+ exists c', step NextCR c (STATE_IDLE_VEC,true,cnt,cref,tr) =
+ (c',REQUEST_NIL).
+ Proof.
+ simpl in c; destruct_products.
+ eapply ex_intro.
+ cbv [NextCR LoopInit]; cbn [step fst snd].
+ simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; by simpl.
+ Qed.
+
+ Lemma NextCR_equiv_IDLE_NE_PREA c cnt cref tr:
+ (cref =? CNT_REF_PREA) = true ->
+ exists c', step NextCR c (STATE_IDLE_VEC,false,cnt,cref,tr) =
+ (c',REQUEST_NIL).
+ Proof.
+ intros; simpl in c; destruct_products; eapply ex_intro.
+ cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
+ apply BVEq_iff_eq in H; subst cref.
+ by rewrite CrefPREA_lt_CNT_REF_PREA.
+ Qed.
+
+ Lemma NextCR_equiv_IDLE_RUNNING c cnt (cref : Counter_ref_t) tr:
+ (cref2Bv cref =? CNT_REF_PREA) = false ->
+ (cref + WAIT < PREA_date) = true ->
+ exists c',
+ step NextCR c (STATE_IDLE_VEC,false,cnt,cref2Bv cref,tr) = (c',tr) /\
+ (snd (snd c')) = tr.
+ Proof.
+ intros Href_service Href_prea; simpl in c; destruct_products; eapply ex_intro.
+ cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
+ rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
+ rewrite CrefPREA_lt_CNT_REF_WAIT; done.
+ Qed.
+
+ (* Lemma NextCR_equiv_IDLE_RUNNING c cnt (cref : Counter_ref_t) tr:
+ (cref2Bv cref =? CNT_REF_PREA) = false ->
+ (cref + WAIT < PREA_date) = true ->
+ exists c', step NextCR c (STATE_IDLE_VEC,false,cnt,cref2Bv cref,tr) =
+ (c',tr).
+ Proof.
+ intros Href_service Href_prea; simpl in c; destruct_products; eapply ex_intro.
+ cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
+ rewrite CrefPREA_lt_CNT_REF_WAIT; done.
+ Qed. *)
+ (* ------------------------------------------------------------------ *)
+
+ Create HintDb update.
+ Lemma Sidle_true :
+ Sidle STATE_IDLE_VEC = true.
+ Proof.
+ apply CavaPreludeProperties.eqb_refl.
+ Qed.
+ Hint Rewrite @Sidle_true : update.
+
+ Lemma Sref_idle_false :
+ Sref STATE_IDLE_VEC = false.
+ Proof.
+ by apply CavaPreludeProperties.eqb_neq.
+ Qed.
+ Hint Rewrite @Sref_idle_false : update.
+
+ Lemma cnt_equiv (cnt : Bvector COUNTER_WIDTH) :
+ (if CeqWAIT cnt then Bvect_false COUNTER_WIDTH
+ else N2Bv_sized COUNTER_WIDTH (Bv2N cnt + 1)) = cnt2Bv (Next_cycle (Bv2cnt cnt)).
+ Proof.
+ cbv [CeqWAIT].
+ destruct (CavaPrelude.eqb (cnt, CNT_WAIT)) eqn:Heq; rewrite Heq.
+ { specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit COUNTER_WIDTH) (x := cnt) as H.
+ apply H in Heq; clear H.
+ unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { rewrite /CNT_WAIT bitvec_literal_correct in Heq.
+ rewrite Heq /Bv2cnt //= Bv2N_N2Bv_sized in x.
+ 2: {
+ rewrite /COUNTER_WIDTH; have id := (N2Nat.id 2).
+ rewrite -id Nat2N.inj_pow //= /Pos.to_nat //= WAIT_PW_2.
+ apply: N_lt_inj; apply /ltP; by rewrite subn1 ltn_predL WAIT_pos.
+ }
+ rewrite Nat2N.id subn1 prednK in x; [ | exact WAIT_pos ]; by rewrite ltnn in x.
+ }
+ { unfold cnt2Bv,OCycle0; by simpl. }}
+ { unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { unfold cnt2Bv; apply f_equal; simpl.
+ rewrite N.add_1_r -(N.succ_pos_pred (Pos.of_succ_nat (N.to_nat (Bv2N cnt)))).
+ apply f_equal; by rewrite predN_of_succ_nat. }
+ { apply ltn_gt in e,x.
+ rewrite leq_eqVlt in e; move: e => /orP [/eqP e | e].
+ { have HH := (@eqb_iff_neq (Vec Bit (@COUNTER_WIDTH SYS_CFG FIFO_CFG))).
+ apply HH in Heq. rewrite /CNT_WAIT bitvec_literal_correct in Heq;
+ rewrite -(N2Bv_sized_Bv2N (@COUNTER_WIDTH SYS_CFG FIFO_CFG) cnt) in Heq.
+ apply N2Bv_sized_neq_if in Heq.
+ by rewrite e subn1 -pred_Sn N2Nat.id in Heq. }
+ { specialize ltn_ord with (n := @WAIT SYS_CFG FIFO_CFG) (i := Ordinal (cnt_bounded cnt)) as H.
+ rewrite //= in H.
+ contradict H; apply /negP; by rewrite -ltnNge.
+ }
+ }
+ }
+ Qed.
+
+ (* -------------- Proofs about Update ------------------------------- *)
+ Lemma Update_equiv_idle_idle (c : circuit_state Update) cnt cref :
+ (cref =? CNT_REF_PREA) = false ->
+ let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
+ let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N cref + 1) in
+ exists c', step Update c (STATE_IDLE_VEC,true,cnt,cref) =
+ (c',(STATE_IDLE_VEC,false,nc,ncref)).
+ Proof.
+ intros Hcref Hcnt; simpl in c; eapply ex_intro.
+ cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
+ cbv [Update Update_s Update_e Update_c Update_cref].
+ cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ autorewrite with update; vm_compute (false && _).
+ apply BVEq_iff_neq in Hcref.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply pair_equal_spec; split.
+ 2: {
+ rewrite orb_false_l andb_true_l.
+ rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
+ }
+ cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
+ vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id andb_false_r.
+ apply pair_equal_spec; split; [
+ apply pair_equal_spec; split; [ by unfold STATE_IDLE_VEC | reflexivity] | ].
+ vm_compute (orb false false); rewrite orb_false_r; by specialize (cnt_equiv cnt).
+ Qed.
+
+ Lemma Update_equiv_idle_ref (c : circuit_state Update) cnt cref e:
+ (cref =? CNT_REF_PREA) = true ->
+ let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
+ let ncref := CNT_REF_NIL in
+ exists c', (step Update c (STATE_IDLE_VEC,e,cnt,cref)) =
+ (c',(STATE_REF_VEC,false,nc,ncref)).
+ Proof.
+ intros Hcref Hcnt; simpl in c; eapply ex_intro.
+ cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
+ cbv [Update Update_s Update_e Update_c Update_cref].
+ cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ autorewrite with update; vm_compute (false && _).
+ apply BVEq_iff_eq in Hcref.
+ specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply pair_equal_spec; split.
+ 2: {
+ rewrite orb_false_l andb_true_l.
+ rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
+ }
+ cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
+ vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id.
+ apply pair_equal_spec; split.
+ 2: {
+ vm_compute (orb false false); rewrite orb_false_r.
+ destruct e; [rewrite negb_true | rewrite negb_false].
+ { rewrite andb_false_r orb_false_r; by specialize (cnt_equiv cnt). }
+ { rewrite andb_true_r.
+ destruct (CrefPREA_lt cref) eqn:Hbug.
+ { by rewrite Hcref CrefPREA_lt_CNT_REF_PREA in Hbug. }
+ { rewrite orb_false_r; by specialize (cnt_equiv cnt). }
+ }
+ }
+ apply pair_equal_spec; split; [ done | ].
+ rewrite Hcref CrefPREA_lt_CNT_REF_PREA; by rewrite andb_false_l.
+ Qed.
+
+ Lemma Update_equiv_idle_running (c : circuit_state Update) cnt
+ (cref : Counter_ref_t) :
+ (cref2Bv cref =? CNT_REF_PREA) = false ->
+ (cref + WAIT < PREA_date) = true ->
+ let nc := CNT_NIL in
+ let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N (cref2Bv cref) + 1) in
+ exists c', step Update c (STATE_IDLE_VEC,false,cnt,(cref2Bv cref)) =
+ (c',(STATE_RUN_VEC,true,nc,ncref)).
+ Proof.
+ intros Href_prea Href_service Hcnt;
+ simpl in c; destruct_products; eapply ex_intro.
+ cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
+ cbv [Update Update_s Update_e Update_c Update_cref].
+ cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ autorewrite with update; fast_simpl_bool;
+ rewrite !orb_false_l !andb_true_l /CrefPREA_eq.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply BVEq_iff_neq in Href_prea as Haux; apply HH in Haux.
+ rewrite Haux //= !orb_false_r andb_true_r !VectorSpec.map_id; clear Haux.
+ apply pair_equal_spec; split; [ | done].
+ apply pair_equal_spec; split; rewrite CrefPREA_lt_CNT_REF_WAIT; try done.
+ by rewrite orb_true_r.
+ Qed.
+ (* ------------------------------------------------------------------ *)
+
+ (* -------------- Proofs about FullEmptyLogic ------------------------------- *)
+ Lemma FEL_emp_equiv (c : circuit_state FullEmptyLogic) wra rda :
+ wra = rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,true)).
+ Proof.
+ intros H; eapply ex_intro.
+ cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
+ cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply pair_equal_spec; split; [ | by rewrite H CavaPreludeProperties.eqb_refl ].
+ rewrite inv_correct; cbv [bind].
+ rewrite fullAdder_cin; cbv [unpackV]; simpl_ret.
+ destruct (one) eqn:Hone; [ | discriminate].
+ destruct ((Bv2N rda) <= (Bv2N wra)) eqn:Hleq;
+ [ | by rewrite H leqnn in Hleq ].
+ assert (N.sub (Bv2N wra) (Bv2N rda) = 0%N); [ by rewrite H N.sub_diag | ].
+ rewrite H0 !bitvec_literal_correct.
+ set (N := N.sub _ _).
+ specialize N2Bv_sized_queuemax_neq0 as H2.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@ADDR_WIDTH CAVA_SYS))
+ (x := N2Bv_sized ADDR_WIDTH 0) (y := N2Bv_sized ADDR_WIDTH N) as HH.
+ by apply HH in H2.
+ Qed.
+
+ Lemma FEL_nemp_wrap1_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
+ let wrap1 := N2Bv_sized ADDR_WIDTH (Bv2N wra + 1) in
+ wra = rda -> exists c' f', step FullEmptyLogic c (wrap1,rda) = (c',(f',false)).
+ Proof.
+ intros; repeat eapply ex_intro; unfold wrap1.
+ cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
+ cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply CavaPreludeProperties.eqb_neq; rewrite H.
+ apply N2Bv_sized_plusone_diff; unfold ADDR_WIDTH.
+ specialize QUEUE_MAX_SIZE_GT_1 as HQ; apply Nat.log2_pos in HQ.
+ by move: HQ => /ltP HQ.
+ Qed.
+
+ Lemma FEL_nemp_NF_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
+ ~~ (fullQueue wra rda) ->
+ wra <> rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,false)).
+ Proof.
+ intros NF H; eapply ex_intro.
+ rewrite /fullQueue in NF.
+ cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
+ cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply pair_equal_spec; split; [ | by apply CavaPreludeProperties.eqb_neq ].
+ rewrite bitvec_literal_correct.
+ rewrite fullAdder_cin; destruct (one) eqn:Hbug; try discriminate; clear Hbug.
+ cbv [unpackV].
+ destruct (_ <= _) eqn:Hleq; apply CavaPreludeProperties.eqb_neq.
+ { set (xx := (Bv2N wra - Bv2N rda)%N); fold xx in NF.
+ set (yy := ((N.of_nat QUEUE_MAX_SIZE - 1)%N)); fold yy in NF.
+ assert (N.size_nat xx <= ADDR_WIDTH);
+ [ apply size_nat_sub_leq; by apply leq_Nle in Hleq | ].
+ assert (N.size_nat yy <= ADDR_WIDTH);
+ [ unfold ADDR_WIDTH, yy; by apply size_nat_qms | ].
+ apply N2Bv_sized_neq_iff; try done; by apply /eqP.
+ }
+ { rewrite {3}/ADDR_WIDTH QUEUE_MAX_SIZE_PW2; apply N2Bv_sized_neq_iff.
+ { assert (Bv2N rda > Bv2N wra); [ lia | ].
+ apply size_nat_qms_sub; by apply ltn_Ntn in H0.
+ }
+ { unfold ADDR_WIDTH; by apply size_nat_qms. }
+ specialize add_1_sub1 with (x := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) as HH.
+ rewrite HH in NF; [ | exact QUEUE_MAX_SIZE_GT_0_N].
+ apply /eqP; exact NF.
+ }
+ Qed.
+
+ Lemma FEL_NF_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
+ ~~ (fullQueue wra rda) ->
+ exists c' e', step FullEmptyLogic c (wra,rda) = (c',(false,e')).
+ Proof.
+ intros NF; unfold fullQueue in NF; repeat eapply ex_intro.
+ cbv [FullEmptyLogic]; cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [reflexivity | ].
+ apply pair_equal_spec; split; [ | reflexivity ].
+ cbv [dropr subtractor EqFULL FullVEC unpackV]; simpl_ident.
+ destruct ((Bv2N rda) <= (Bv2N wra)) eqn:Hleq;
+ destruct (one) eqn:Hone; try discriminate;
+ rewrite fullAdder_cin Hleq;
+ apply CavaPreludeProperties.eqb_neq; move: NF => /eqP NF.
+ { set (xx := (Bv2N wra - Bv2N rda)%N); fold xx in NF.
+ set (yy := ((N.of_nat QUEUE_MAX_SIZE - 1)%N)); fold yy in NF.
+ assert (N.size_nat xx <= ADDR_WIDTH);
+ [ apply size_nat_sub_leq; by apply leq_Nle in Hleq | ].
+ assert (N.size_nat yy <= ADDR_WIDTH);
+ [ unfold ADDR_WIDTH, yy; by apply size_nat_qms | ].
+ apply N2Bv_sized_neq_iff; try done; by apply /eqP.
+ }
+ { rewrite {3}/ADDR_WIDTH QUEUE_MAX_SIZE_PW2; apply N2Bv_sized_neq_iff.
+ { assert (Bv2N rda > Bv2N wra) as H; [ lia | ].
+ apply size_nat_qms_sub; by apply ltn_Ntn in H.
+ }
+ { unfold ADDR_WIDTH; by apply size_nat_qms. }
+ specialize add_1_sub1 with (x := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) as HH.
+ by rewrite HH in NF; [ | exact QUEUE_MAX_SIZE_GT_0_N].
+ }
+ Qed.
+ (* ------------------------------------------------------------------ *)
+
+ Lemma incrn_pointr_true_equiv (c : circuit_state incr_pointr) ad :
+ step incr_pointr c (ad,true) =
+ (tt,N2Bv_sized ADDR_WIDTH (Bv2N ad + 1)).
+ Proof.
+ cbv [incr_pointr step] ; by simpl_ident.
+ Qed.
+
+ Lemma incrn_pointr_false_equiv (c : circuit_state incr_pointr) ad :
+ step incr_pointr c (ad,false) = (tt,ad).
+ Proof.
+ cbv [incr_pointr step] ; by simpl_ident.
+ Qed.
+
+ Create HintDb get_state.
+ Hint Unfold get_st get_cnt get_cref get_reqqueue get_addr_RequestQueue get_pop get_mem
+ get_memcells_RequestQueue get_mem_RequestQueue get_memcells get_cr : get_state.
+
+ (* the not full could come either be satisfies from the not full hypothesis
+ or from wra = rda *)
+ Lemma RQ_fst_pushT_popF_NF (c : circuit_state RequestQueue') c_req :
+ let '(wra,rda) := get_addr_RequestQueue c in
+ let S := get_memcells_RequestQueue c in
+ let wra_idx := N.to_nat (Bv2N wra) in
+ let memcells_spec := Cells_read true wra_idx c_req S in
+ ~~ (fullQueue wra rda) -> exists c',
+ ((Cells_data (get_memcells_RequestQueue c') = memcells_spec) /\
+ (fst (get_addr_RequestQueue c')) = (N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) /\
+ (snd (get_addr_RequestQueue c')) = rda) /\
+ fst (step RequestQueue' c (true,c_req,false)) = c'.
+ Admitted.
+ (* Proof.
+ simpl in c; destruct_products.
+ unfold get_addr_RequestQueue; intros Hfull; eapply ex_intro; split; [ | reflexivity].
+ set (p := step RequestQueue' _ _).
+ cbv [RequestQueue' LoopInit fork2] in p.
+ cbn [step] in p; cbn [fst snd] in p; simpl_ret_H p; cbv [fst snd] in p.
+ specialize FEL_NF_equiv with (c := (u17, (u19, u20, u18), u16))
+ (rda := t0) (wra := t) as H; apply H in Hfull; clear H.
+ destruct Hfull as [cs_FEL' [empty_o Hfull]].
+ unfold p; clear p; rewrite Hfull.
+ cbn [fst snd bind inv and2 or2]; fast_simpl_bool.
+ rewrite (surjective_pairing (step memqueue' _ _)).
+ rewrite incrn_pointr_true_equiv incrn_pointr_false_equiv.
+ rewrite (surjective_pairing (step FullEmptyLogic _ _)).
+ set (fel := step FullEmptyLogic _ _).
+ split.
+ { simpl in fel; unfold fel; cbv [snd fst].
+ cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ cbv [memqueue' Memory' mem_write mem_read]; cbn [step fst snd]; simpl_ident; cbv [fst snd].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ cbv [fst snd].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ fold mem_cells_.
+ specialize @Cells_matchX with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
+ (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
+ (S0 := c) (we := true) (wd := c_req) (wa := (N.to_nat (Bv2N t))) as HH.
+ rewrite -HH; [reflexivity | | ].
+ { intros.
+ rewrite /indexConst; simpl_ident.
+ rewrite /decode; simpl_ident.
+ admit.
+ }
+ { rewrite /indexConst; simpl_ident.
+ rewrite /decode; simpl_ident.
+ admit.
+ }
+ }
+ split; by simpl.
+ Admitted. *)
+
+ (* Ignoring the full signal because it just goes to the output *)
+ Lemma RQ_snd_pushT_empty (c : circuit_state RequestQueue') c_req pop :
+ let '(wra,rda) := get_addr_RequestQueue c in
+ let S := get_memcells_RequestQueue c in
+ let rda_idx := N.to_nat (Bv2N rda) in
+ let wra_idx := N.to_nat (Bv2N wra) in
+ let memcells' := Cells_read true wra_idx c_req S in
+ let mem_val := nth_default (req_null) rda_idx memcells' in
+ wra = rda -> exists f',
+ snd (step RequestQueue' c (true,c_req,pop)) = (f',mem_val,true).
+ Admitted.
+ (* simpl in c; destruct_products; rename t0 into rda, t into wra.
+ autounfold with get_state; intros.
+ cbv [RequestQueue' LoopInit fork2]; simpl_ret; cbn [step fst snd].
+ eapply FEL_emp_equiv with (c := (u17,(u19,u20,u18), u16)) in H as HH.
+ destruct HH as [cs_FEL HH]; rewrite HH.
+ cbn [fst snd bind inv and2 or2].
+ rewrite (surjective_pairing (step memqueue' (u12,c,u11) _)).
+ cbv [fst snd]; fast_simpl_bool.
+ rewrite incrn_pointr_true_equiv if_same incrn_pointr_false_equiv; clear HH.
+ eapply FEL_nemp_wrap1_equiv with (c := (u4, (u6, u7, u5), u3)) in H as HH.
+ destruct HH as [cs_FELL [full_o HH]]; rewrite HH; clear HH.
+ eapply ex_intro.
+ apply pair_equal_spec; split; [ | reflexivity ].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ cbv [memqueue' Memory' mem_write mem_read].
+ cbn [step fst snd]; simpl_ret.
+ rewrite (surjective_pairing (step (mem_cells _ _ _ _) c _)).
+ specialize @Cells_data_match with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
+ (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
+ (S0 := c) (we := true) (wa := (N.to_nat (Bv2N wra))) (wd := c_req) as HH.
+ rewrite -HH.
+ { cbv [indexAt indexConst defaultCombValue].
+ cbv [unpackV bind]; simpl_ret.
+ rewrite nth_0; simpl; unfold req_null.
+ reflexivity.
+ }
+ all: admit.
+ Admitted. *)
+
+ Lemma RQ_snd_pushT_popF_NF_nempty (c : circuit_state RequestQueue') c_req:
+ let '(wra,rda) := get_addr_RequestQueue c in
+ let S := get_memcells_RequestQueue c in
+ let rda_idx := N.to_nat (Bv2N rda) in
+ let wra_idx := N.to_nat (Bv2N wra) in
+ let memcells' := Cells_read true wra_idx c_req S in
+ let mem_val := nth_default (req_null) rda_idx memcells' in
+ ~~ (fullQueue wra rda) -> wra <> rda -> exists full_o,
+ snd (step RequestQueue' c (true,c_req,false)) = (full_o,mem_val,false).
+ Admitted.
+ (*
+ simpl in c; destruct_products; rename t0 into rda, t into wra.
+ autounfold with get_state; intros.
+ cbv [RequestQueue' LoopInit fork2]; simpl_ret; cbn [step fst snd].
+ apply FEL_nemp_NF_equiv with (c := (u17,(u19,u20,u18), u16)) in H as HH; [ | done].
+ destruct HH as [cs_FEL HH]; rewrite HH.
+ cbn [fst snd bind inv and2 or2]; fast_simpl_bool.
+ rewrite (surjective_pairing (step memqueue' (u12,c,u11) _)).
+ cbv [fst snd]; fast_simpl_bool.
+ rewrite incrn_pointr_true_equiv.
+ rewrite incrn_pointr_false_equiv; clear HH.
+ (* The second logic doesn't really matter much *)
+ rewrite (surjective_pairing (step FullEmptyLogic _ _)).
+ eapply ex_intro.
+ apply pair_equal_spec; split; [ | reflexivity].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ destruct_pair_let.
+ cbv [memqueue' Memory' mem_write mem_read].
+ cbn [step fst snd]; simpl_ret.
+ rewrite (surjective_pairing (step (mem_cells _ _ _ _) c _)).
+ specialize @Cells_data_match with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
+ (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
+ (S0 := c) (we := true) (wa := (N.to_nat (Bv2N wra))) (wd := c_req) as HH.
+ rewrite -HH //=.
+ all: admit.
+ Admitted. *)
+
+ (* IDLE -> RUNNING *)
+ Theorem SM_Eq_2b (t : nat) (c_state : State_t) c0 r0 r1
+ (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) r :
+ (c1 + WAIT < PREA_date) = true ->
+ (nat_of_ord c1 == PREA_date - 1) = false ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Proof.
+ intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rewrite NF //= in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
+ rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
+ move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] HQ] /eqP EqPop].
+ apply EqQueue_diff_adr in HQ as Hadr.
+
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref pop.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ specialize (RQ_snd_pushT_popF_NF_nempty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req) as S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
+ apply S in NFULL as S'; [ | done]; clear S; destruct S' as [full_o H].
+ rewrite H. clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ apply NextCR_equiv_IDLE_RUNNING with (c := (u9, (u10, cr))) (cnt := cnt2Bv c0)
+ (cref := c1) (tr := tr) in Href_service as H.
+ 2: by apply cref_preadate_false in Href_prea.
+ destruct H as [cs_nextcr H]; destruct H as [H Htr].
+ rewrite H; clear H; cbv [fst snd].
+
+ specialize (CmdGen_equiv_idle_to_running u6 (cnt2Bv c0) c1 tr) as S.
+ specialize Href_service as Href_service_.
+ apply S in Href_service; clear S; rename Href_service into H.
+ 2: by apply cref_preadate_false in Href_prea.
+ destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
+
+ specialize (Update_equiv_idle_running u4 (cnt2Bv c0) c1) as S;
+ apply S in Href_service_ as S'; clear S.
+ 2: by apply cref_preadate_false in Href_prea.
+ destruct S' as [cs_update H]; rewrite H; clear H; cbn [fst snd].
+
+ rewrite /Next_state Href_prea Href_service_ /State_Eq.
+ specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
+ apply S in NFULL as H; clear S.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ autounfold with get_state.
+
+ apply /andP; split.
+ 2: {
+ unfold tr; simpl in Mem; move: Mem => /andP [EqReq_r0 Mem].
+ rewrite {2}/get_memcells_RequestQueue /get_mem_RequestQueue /get_memcells in Hrw.
+ apply (memcell_nch c wra rda c_req req_null) in Hadr as HH.
+ rewrite /req_null //= in HH.
+ rewrite VectorSpec.map_id /Bvect_false HH in EqReq_r0.
+ by rewrite /req_null //=.
+ }
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2: {
+ rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; simpl; trivial. }
+ apply /andP; split.
+ 2 : {
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; rewrite Htr;
+ unfold tr; simpl in Mem; move: Mem => /andP [EqReq_r0 Mem].
+ rewrite {2}/get_memcells_RequestQueue /get_mem_RequestQueue /get_memcells in Hrw.
+ apply (memcell_nch c wra rda c_req req_null) in Hadr as HH.
+ rewrite /req_null //= in HH.
+ rewrite VectorSpec.map_id /Bvect_false HH in EqReq_r0.
+ by rewrite /req_null //=.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
+ simpl; rewrite eq_refl.
+ rewrite /Enqueue /R NF.
+ simpl in HQ.
+ (* specialize (EqQueue_aux wra rda r0 r1 r) as HH; apply HH; done. *)
+ specialize (EqQueue_aux wra rda r0 r1 r) as HH.
+ apply HH in NFULL as HH'; clear HH; try done.
+ (* move: HH' => /andP [neqq HH]; fold @EqQueue in HH. *)
+ move: HH'; simpl; intros HH.
+ move: HH => /andP [Hadr_neq HH].
+ rewrite /EqQueue in HH'.
+
+ simpl; rewrite Hadr; unfold R; rewrite NF //=.
+
+ }
+
+ 2 : {
+ rewrite /Enqueue (surjective_pairing (step RequestQueue' _ _)) H.
+ autounfold with get_state in Hrda',Hwra'; cbn [fst snd]; rewrite Hwra' Hrda'; clear Hwra' Hrda'.
+ unfold R; rewrite NF.
+ specialize (EqQueue_aux wra rda r0 r1 r) as HH; apply HH; done.
+ }
+
+
+
+
+
+
+
+
+ Theorem SM_Eq_2a (t : nat) (c_state : State_t) c0
+ (c1 : Counter_ref_t) (c_req : Bvector REQUEST_WIDTH) r :
+ (c1 + WAIT < PREA_date) = true ->
+ (nat_of_ord c1 == PREA_date - 1) = false ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 []) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Proof.
+ intros Href_service Href_prea f_state R NF EqR H; unfold FIFOSM.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rewrite NF //= in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
+ rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
+ move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr] /eqP EqPop].
+ simpl in Hadr.
+
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref, Hadr; subst s cnt cref pop.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ specialize (RQ_snd_pushT_empty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
+ apply S in Hadr as H; clear S; destruct H as [full_o H].
+ rewrite H; clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ specialize NextCR_equiv with (c := (u9, (u10, cr))) (cnt := cnt2Bv c0)
+ (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
+ rewrite H; cbv [fst]; clear H. cbn [snd].
+
+ apply cref_preadate_false in Href_prea as Href_prea_.
+ apply (CmdGen_equiv_idle_to_idle u6 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
+ destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
+
+ apply (Update_equiv_idle_idle u4 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
+ destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
+
+ rewrite /Next_state Href_prea /State_Eq.
+ specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
+ apply S in NFULL as H; clear S.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ autounfold with get_state.
+ rewrite Href_service.
+
+ apply /andP; split.
+ 2 : exact EqReqNil.
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2: {
+ rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; simpl; trivial. }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
+ simpl; rewrite Hadr; unfold R; rewrite NF //=.
+ apply /andP; split.
+ { apply /negPf; apply (@N2Bv_sized_eq_p1_false ADDR_WIDTH rda);
+ specialize ADDR_WIDTH_pos as Hpos; by move: Hpos => /ltP Hpos. }
+ by apply BVEq_iff_eq.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hrda'.
+ simpl; unfold R; rewrite NF //= /EqMem //= andb_true_r.
+ rewrite Hrw; autounfold with get_state; rewrite Hadr.
+ specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req c) as H'.
+ rewrite H'; exact EqR.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
+ destruct_pair_let.
+ rewrite /Next_cycle_ref.
+ set Hc := c1.+1 < WAIT_REF; dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { rewrite /cref2Bv //= Bv2N_N2Bv_sized.
+ 2: {
+ unfold COUNTER_REF_WIDTH; rewrite WAIT_REF_PW_N.
+ destruct c1; simpl; apply N_lt_inj; by apply /ltP.
+ }
+ rewrite /N2Bv_sized.
+ destruct (N.of_nat c1 + 1)%N eqn:Hbug;
+ [ rewrite N.add_1_r in Hbug; contradict Hbug; apply N.neq_succ_0 | ].
+ apply BVEq_iff_eq; f_equal; lia.
+ }
+ { destruct c1; simpl in x,e,Hc0,Href_prea_,Href_service,Href_prea.
+ rewrite /cref2Bv VectorSpec.map_id //= in Href_prea_.
+ apply ltn_gt in x; rewrite leq_eqVlt in x; move: x => /orP [/eqP x | x].
+ { assert (m = WAIT_REF.-1); [ lia | ].
+ rewrite H0 addnC -ltn_subRL in Href_service.
+ rewrite -subn1 ltn_subLR in Href_service; [ | exact WAIT_REF_pos ].
+ contradict Href_service; apply /negP.
+ rewrite -leqNgt leq_eqVlt addnC.
+ specialize WAIT_REF_PREA_date as HH.
+ apply ltn_trans with (m := PREA_date - WAIT + 1) in HH;
+ [ by rewrite HH orb_true_r | ].
+ rewrite -subnA.
+ { by rewrite ltn_subrL subn_gt0 WAIT_gt_one PREA_date_pos. }
+ { exact WAIT_pos. }
+ { by rewrite leq_eqVlt PREA_date_WAIT orb_true_r. }
+ }
+ { rewrite ltnS in x; contradict x; apply /negP; by rewrite -ltnNge. }
+ }
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //=.
+ destruct_pair_let.
+ rewrite /cnt2Bv; apply BVEq_iff_eq; f_equal.
+ apply Nat2N.inj_iff.
+ rewrite /Bv2cnt /Next_cycle //= Bv2N_N2Bv_sized //=.
+ 2: {
+ destruct c0; rewrite //= /COUNTER_WIDTH.
+ rewrite WAIT_PW_2_N; apply N_lt_inj; by apply /ltP.
+ }
+ set (Hc := _ < WAIT); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro; try rewrite Nat2N.id;
+ try by rewrite Nat2N.id in x; move: Logic.eq_refl; rewrite {2 3}x; simpl; intro.
+ }
+ cbv [get_st]; rewrite (surjective_pairing (step RequestQueue' _ _)) H //=; destruct_pair_let.
+ by [].
+ Qed.
+
+
+ (* Assuming a non-full regime, i.e., the front-end has yielded a valid request *)
+ (* If R is non empty than the queue is not full *)
+ Theorem SM_Eq_1b (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) r0 r1 (r : Request_t) :
+ (nat_of_ord c1 == PREA_date - 1) = true ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Admitted.
+ (* Proof.
+ intros Href_prea f_state R NF EqR H; unfold FIFOSM.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rewrite NF //= in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
+ rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
+ move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] HQ] /eqP EqPop].
+ apply EqQueue_diff_adr in HQ as Hadr.
+
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref pop.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ specialize (RQ_snd_pushT_popF_NF_nempty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req) as S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
+ apply S in NFULL as S'; [ | done]; clear S; destruct S' as [full_o H].
+ rewrite H. clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ specialize (NextCR_equiv_IDLE_NE_PREA (u9, (u10, cr)) (cnt2Bv c0) (cref2Bv c1) tr) as S.
+ apply cref_preadate_true in Href_prea as Href_prea_.
+ apply S in Href_prea_ as S'; clear S; destruct S' as [cs_nextcr H]; rewrite H.
+
+ cbn [fst snd]; clear H.
+ apply (CmdGen_equiv_idle_to_ref u6 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
+ destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
+
+ apply (Update_equiv_idle_ref u4 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
+ destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
+
+ rewrite /Next_state Href_prea /State_Eq.
+ specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
+ apply S in NFULL as H; clear S.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ autounfold with get_state.
+
+ apply /andP; split.
+ 2 : exact EqReqNil.
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2: {
+ rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; simpl; trivial. }
+ apply /andP; split.
+ 2 : {
+ rewrite /Enqueue (surjective_pairing (step RequestQueue' _ _)) H.
+ autounfold with get_state in Hrda',Hwra'; cbn [fst snd]; rewrite Hwra' Hrda'; clear Hwra' Hrda'.
+ unfold R; rewrite NF.
+ specialize (EqQueue_aux wra rda r0 r1 r) as HH; apply HH; done.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite /EqMem (surjective_pairing (step RequestQueue' _ _)) H Hrw /Enqueue.
+ autounfold with get_state in Hrda'; cbn [fst snd]; rewrite Hrda'; clear Hrda'.
+ autounfold with get_state; unfold R; rewrite NF.
+ apply EqMem_rcons; done.
+ }
+ apply /andP; split.
+ 2 : {
+ cbv [get_cref].
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //= VectorSpec.map_id.
+ destruct_pair_let.
+ rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
+ }
+ cbv [get_st]; rewrite (surjective_pairing (step RequestQueue' _ _)) H //=; destruct_pair_let.
+ by [].
+ Qed. *)
+
+ Theorem SM_Eq_1a (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) r :
+ (nat_of_ord c1 == PREA_date - 1) = true ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: r] -> EqReq r c_req -> State_Eq (IDLE c0 c1 []) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Admitted.
+ (* Proof.
+ intros Href_prea f_state R NF EqR H; unfold FIFOSM.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL; move: NF => /eqP NF.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rewrite NF //= in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
+ rewrite /State_Eq /EqMem in H; autounfold with get_state in H; cbn [fst snd] in H.
+ move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr] /eqP EqPop].
+ simpl in Hadr.
+
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref, Hadr; subst s cnt cref pop.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ specialize (RQ_snd_pushT_empty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
+ apply S in Hadr as H; clear S; destruct H as [full_o H].
+ rewrite H; clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ specialize NextCR_equiv with (c := (u9, (u10, cr))) (cnt := cnt2Bv c0)
+ (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
+ rewrite H; cbv [fst]; clear H.
+
+ apply cref_preadate_true in Href_prea as Href_prea_; cbn [fst snd].
+ apply (CmdGen_equiv_idle_to_ref u6 (cnt2Bv c0) (cref2Bv c1) true) in Href_prea_ as H.
+ destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
+
+ apply (Update_equiv_idle_ref u4 (cnt2Bv c0) (cref2Bv c1) true) in Href_prea_ as H.
+ destruct H as [cs_update H]; rewrite H; clear H.
+
+ rewrite /Next_state Href_prea /State_Eq.
+ specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
+ apply S in NFULL as H; clear S.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ autounfold with get_state.
+
+ apply /andP; split.
+ 2 : exact EqReqNil.
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2: {
+ rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; simpl; trivial. }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
+ simpl; rewrite Hadr; unfold R; rewrite NF //=.
+ apply /andP; split.
+ { apply /negPf; apply (@N2Bv_sized_eq_p1_false ADDR_WIDTH rda);
+ specialize ADDR_WIDTH_pos as Hpos; by move: Hpos => /ltP Hpos. }
+ by apply BVEq_iff_eq.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hrda'.
+ simpl; unfold R; rewrite NF //= /EqMem //= andb_true_r.
+ rewrite Hrw; autounfold with get_state; rewrite Hadr.
+ specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req c) as H'.
+ rewrite H'; exact EqR.
+ }
+ apply /andP; split.
+ 2 : {
+ cbv [get_cref].
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //= VectorSpec.map_id.
+ destruct_pair_let.
+ rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
+ }
+ cbv [get_st]; rewrite (surjective_pairing (step RequestQueue' _ _)) H //=; destruct_pair_let.
+ by [].
+ Qed. *)
+
+ (* Have to add the full case *)
+ (* REF bounded with PREA_date or arbitrary parameter *)
+ (* if REF is bounded with PREA_date, a problem with cref + WAIT *)
+ (* try bound with random parameter, but will not be correspondent to Next_cycle *)
+ Theorem SM_Eq_NFULL (t : nat) (c_state : State_t) (f_req: Request_t)
+ (c_req : Bvector REQUEST_WIDTH) (push : bool) :
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R == [:: f_req] -> EqReq f_req c_req -> State_Eq f_state c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R f_state in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Proof.
+ destruct (f_state) eqn:Hf_state.
+ { destruct (nat_of_ord c0 == PREA_date - 1) eqn:Hcref_prea; move: Hcref_prea.
+ { destruct r eqn:HR.
+ { apply SM_Eq_1a. }
+ { apply SM_Eq_1b. }
+ }
+ { destruct (c0 + WAIT < PREA_date) eqn:Hcref_service; move: Hcref_service.
+ { destruct r eqn:HR.
+ { apply SM_Eq_2a. }
+ { admit. (* Case 2b: IDLE -> RUNNING (non-empty queue) *)}
+ }
+ { destruct r eqn:HR.
+ { admit. (* Case 3a: IDLE -> IDLE (empty queue )*)}
+ { admit. (* Case 3b: IDLE -> IDLE (non empty queue) *) }
+ }
+ }
+ }
+ { destruct (nat_of_ord c0 == OACT_date) eqn:Hact_date.
+ { destruct r eqn:HR.
+ { admit. (* Case 4a : RUNNING -> RUNNING (ACT) (empty queue) *) }
+ { admit. (* Case 4b : RUNNING -> RUNNING (ACT) (non empty queue) *)}
+ }
+ { destruct (nat_of_ord c0 == OCAS_date) eqn:Hcas_date.
+ { destruct r eqn:HR.
+ { admit. (* Case 5a : RUNNING -> RUNNING (CAS) (empty queue )*) }
+ { admit. (* Case 5b : RUNNING -> RUNNING (CAS) (non-empty queue) *)}
+ }
+ { destruct (nat_of_ord c0 == WAIT.-1) eqn:Hend_date.
+ { destruct r eqn:HR.
+ { admit. (* Case 6a : RUNNING -> IDLE (empty queue) *) }
+ { admit. (* Case 6b : RUNNING -> IDLE (non empty queue) *)}
+ }
+ { destruct r eqn:HR.
+ { admit. (* Case 7a : RUNNING -> RUNNING (empty queue) *) }
+ { admit. (* Case 7b : RUNNING -> RUNNING (non empty queue) *) }
+ }
+ }
+ }
+ }
+ { destruct (nat_of_ord c0 == OREF_date) eqn:Href_date.
+ { destruct r eqn:HR.
+ { admit. }
+ { admit. }
+ }
+ { destruct (nat_of_ord c0 == OENDREF_date) eqn:Hendref_date.
+
+ }
+
+ }
+
+End EquivalenceProof.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Lib/CavaFIFOREFProperties2.v b/framework/CavaDRAM/Lib/CavaFIFOREFProperties2.v
new file mode 100644
index 0000000..949d7ab
--- /dev/null
+++ b/framework/CavaDRAM/Lib/CavaFIFOREFProperties2.v
@@ -0,0 +1,311 @@
+Set Printing Projections.
+From CavaDRAM Require Import CavaFIFOREF.
+Require Import Program.
+
+Ltac destruct_products :=
+ repeat match goal with
+ | p: _ * _ |- _ => destruct p
+ | H: _ /\ _ |- _ => let Hl := fresh H "l" in let Hr := fresh H "r" in destruct H as [Hl Hr]
+ | E: exists y, _ |- _ => let yf := fresh y in destruct E as [yf E]
+ end.
+
+Ltac simplify_step :=
+ first [ destruct_pair_let
+ | rewrite eqb_nat_to_bitvec_sized; by Lia.lia
+ | rewrite nat_to_bitvec_to_nat; by Lia.lia
+ | progress simpl_ident
+ | progress autorewrite with to_spec
+ | progress cbn [fst snd map] ].
+
+Ltac simplify := repeat simplify_step.
+Ltac simpl_ret := cbv [ret monad CombinationalSemantics Identity.Monad_ident].
+
+Section CavaSMProperties2.
+ (* From Cava *)
+ Existing Instance CombinationalSemantics.
+ (* From CavaDRAM*)
+ Context {CAVA_SYS : CavaSystem}.
+ (* From CoqDRAM *)
+ Existing Instance REQESTOR_CFG.
+ Context {SYS_CFG : System_configuration}.
+ Context {FIFO_CFG : FIFO_configuration}.
+ Context {AF : Arrival_function_t}.
+ Existing Instance FIFO_implementation.
+
+ Definition State_t := circuit_state FIFOSM.
+
+ Definition get_mem (s : State_t) :=
+ let '(_,(_,(_,(_,(_, (_, (_,_, _),_)),_,mem_state,_,
+ (_, _),(_, (_, (_, _, _),_)),_,_),_),(_,(_,(_,(_,
+ (_, (_,_)),_, _, _,_, _,_),_),_)),_)) := s in mem_state.
+
+ Definition get_pop (s : State_t) :=
+ let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
+ (_,_),(_,(_,(_,_,_),_)),_,_),_),(_,(_,(_,(_,
+ (_, (_,_)),_,_,_,_,_,_),_),_)),pop)) := s in pop.
+
+ Definition get_st (s : State_t) :=
+ let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
+ (_,_),(_,(_,(_,_,_),_)),_,_),_),(_,(_,(_,(_,
+ (_, (_,_)),_,_,_,_,_,_),_),st)),_)) := s in st.
+
+ Definition get_cnt (s : State_t) :=
+ let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
+ (_,_),(_,(_,(_,_,_),_)),_,_),_),(_,(_,(_,(_,
+ (_, (_,_)),_,_,_,_,_,_),cnt),_)),_)) := s in cnt.
+
+ Definition get_cref (s : State_t) :=
+ let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
+ (_,_),(_,(_,(_,_,_),_)),_,_),_),(_,(_,(_,(_,
+ (_, (_,_)),_,_,_,_,_,cref),_),_)),_)) := s in cref.
+
+ Definition get_cr (s : State_t) :=
+ let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
+ (_,_),(_,(_,(_,_,_),_)),_,_),_),(_,(_,(_,(_,
+ (_, (_,cr)),_,_,_,_,_,_),_),_)),_)) := s in cr.
+
+ Definition get_wra (s : State_t) :=
+ let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
+ (_,_),(_,(_,(_,_,_),_)),_,_),wra),(_,(_,(_,(_,
+ (_, (_,_)),_,_,_,_,_,_),_),_)),_)) := s in wra.
+
+ Definition get_rda (s : State_t) :=
+ let '(_,(_,(_,(_,(_,(_,(_, _, _),_)),_,_,_,
+ (_,_),(_,(_,(_,_,_),_)),_,rda),_),(_,(_,(_,(_,
+ (_, (_,_)),_,_,_,_,_,_),_),_)),_)) := s in rda.
+
+ Definition cnt2Bv (cnt : Counter_t) :=
+ N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)).
+
+ Definition cref2Bv (cref : nat) :=
+ N2Bv_sized COUNTER_REF_WIDTH (N.of_nat cref).
+
+ Program Definition EqArrival (r : Requests_t) (r' : Bvector REQUEST_WIDTH) : bool.
+ Admitted.
+
+ Program Definition EqReq (r : Request_t) (r' : Bvector REQUEST_WIDTH) : bool.
+ Admitted.
+
+ (* Write this *)
+ Program Definition EqMem (P : Requests_t) (mem : circuit_state memqueue) : bool.
+ Admitted.
+
+ (* Rewrite the predicate *)
+ Import BvectorNotations.
+ Open Scope Bvector_scope.
+ Definition State_Eq' (fram_state : FIFO_state_t) (cava_state : State_t) : bool :=
+ let s := get_st cava_state in
+ let c' := get_cnt cava_state in
+ let cref' := get_cref cava_state in
+ let r' := get_cr cava_state in
+ let wra := get_wra cava_state in
+ let rda := get_rda cava_state in
+ let pop := get_pop cava_state in
+ let mem := get_mem cava_state in
+ match fram_state with
+ | IDLE c cref P =>
+ (s =? STATE_IDLE_VEC) && (cnt2Bv c =? c') && (cref2Bv cref =? cref') && (
+ match P with
+ | [::] => (wra =? rda)
+ | x :: x0 => EqMem (x :: x0) mem
+ end)
+ | RUNNING c cref P r =>
+ (s =? STATE_RUN_VEC) && (cnt2Bv c =? c') && (cref2Bv cref =? cref') && (
+ match P with
+ | [::] => (wra =? rda)
+ | x0 :: xS => EqMem (x0 :: xS) mem
+ end) &&
+ (EqReq r r')
+ | REFRESHING cref P =>
+ (s =? STATE_REF_VEC) && (cref2Bv cref =? cref') &&
+ ((wra =? rda) == (P == [::]))
+ end.
+
+ Definition State_Eq (fram_state : FIFO_state_t) (cava_state : State_t) : bool :=
+ let s := get_st cava_state in
+ let c' := get_cnt cava_state in
+ let cref' := get_cref cava_state in
+ let r' := get_cr cava_state in
+ let wra := get_wra cava_state in
+ let rda := get_rda cava_state in
+ let pop := get_pop cava_state in
+ match fram_state with
+ | IDLE c cref P =>
+ (s =? STATE_IDLE_VEC) && (cnt2Bv c =? c') && (cref2Bv cref =? cref') &&
+ ((wra =? rda) == (P == [::]))
+ | RUNNING c cref P r =>
+ (s =? STATE_RUN_VEC) && (cnt2Bv c =? c') && (cref2Bv cref =? cref') && (EqReq r r') &&
+ ((wra =? rda) == (P == [::]))
+ | REFRESHING cref P =>
+ (s =? STATE_REF_VEC) && (cref2Bv cref =? cref') &&
+ ((wra =? rda) == (P == [::]))
+ end.
+
+ Lemma BVEq_eq {N} (a b : Bvector N) :
+ (a =? b) = true -> a = b.
+ Proof.
+ intros.
+ specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := a) (v2 := b) as HH.
+ unfold BVeq in H.
+ apply HH in H; [exact H | exact Bool.eqb_true_iff ].
+ Qed.
+
+ (* NOT IMPORTANT FOR FULL PROOF -> FOR FALSE SIGNAL *)
+ Lemma fullAdder_cin {n} (x y : Vector.t bool n) cin:
+ let c := N.to_nat (Bv2N y) <= N.to_nat (Bv2N x) in
+ let out := if cin
+ then (if c then (N.sub (Bv2N x) (Bv2N y)) else Bv2N (Vec.xor (x,y)))
+ else (if c then Bv2N (Vector.map negb (Vec.xor (x,y))) else N.add (Bv2N x) (Bv2N (Vector.map negb y))) in
+ fst (col fullAdder cin (vcombine x (Vector.map negb y))) =
+ Vec.bitvec_literal (N2Bv_sized n out).
+ Admitted.
+
+ (* NOT IMPORTANT FOR FULL PROOF -> FOR FALSE SIGNAL *)
+ Lemma P2Bv_sized_neq_iff (n : nat) (x y : positive) :
+ (Pos.size_nat x <= n) ->
+ (Pos.size_nat y <= n) ->
+ (P2Bv_sized n x <> P2Bv_sized n y) <-> x <> y.
+ Proof.
+ revert x y; induction n; intros.
+ { split; intros.
+ { simpl in H1. contradict H1. reflexivity. }
+ { pose proof (Pos_size_nat_nonzero x).
+ contradict H. apply /negP. rewrite -ltnNge.
+ apply /ltP; exact H2. }
+ }
+ { split; try congruence; [].
+ cbn [P2Bv_sized].
+ destruct x,y; try congruence; [ | | | ].
+ all: cbn [Pos.size_nat] in *.
+ all: admit.
+ }
+ Admitted.
+
+ (* NOT IMPORTANT FOR FULL PROOF -> FOR FALSE SIGNAL *)
+ Lemma N2Bv_sized_neq_iff: forall (n : nat) (x y : N),
+ (N.size_nat x <= n)%coq_nat -> (N.size_nat y <= n)%coq_nat ->
+ N2Bv_sized n x <> N2Bv_sized n y <-> x <> y.
+ Proof.
+ destruct x, y; cbn [N.size_nat N2Bv_sized]; intros; split; intros.
+ 8: {
+ rewrite P2Bv_sized_neq_iff; try congruence.
+ all: apply /leP; try (exact H || exact H0).
+ }
+ all: try discriminate.
+ all: try (cbv [Bvect_false] in H1; done).
+ all: try (apply P2Bv_nonzero in H0; apply ssrfun.nesym in H0).
+ all: try exact H0.
+ all: try by apply P2Bv_nonzero in H.
+ all: try (congruence).
+ Qed.
+
+ (* NOT IMPORTANT FOR FULL PROOF -> FOR FALSE SIGNAL *)
+ Lemma FullEmptyLogic_equiv (c : circuit_state FullEmptyLogic) wra rda :
+ wra = rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,true)).
+ Proof.
+ intro H; evar (c' : circuit_state FullEmptyLogic); exists c'.
+ cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL subtractor FullVEC];
+ cbn [step fst snd].
+ rewrite H CavaPreludeProperties.eqb_refl.
+ rewrite fullAdder_cin.
+ assert ((N.to_nat (Bv2N rda) <= N.to_nat (Bv2N rda)) = true); [by rewrite leqnn | ].
+ rewrite H0.
+ assert (N.sub (Bv2N rda) (Bv2N rda) = 0%N); [ by rewrite N.sub_diag | ]b_neq;
+ [ instantiate (c' := ((), ((), (), ()), ())); by unfold c' | ].
+ rewrite !bitvec_literal_correct.
+ apply N2Bv_sized_neq_iff.
+ { apply Nat.le_0_l. }
+ { rewrite N.sub_1_r -Nat2N.inj_pred.
+ apply N.size_nat_le_nat; unfold ADDR_WIDTH.
+ specialize QUEUE_MAX_SIZE_GT_0 as Hq0.
+ apply Nat.log2_spec in Hq0 as [H2 H2_].
+ admit. (* lt / log2 / pow 2*)
+ }
+ { specialize QUEUE_MAX_SIZE_GT_1 as Hq1.
+ apply Lt.lt_0_neq in Hq1.
+ admit. (* Nat / nat*)
+ }
+ Admitted.
+
+ Definition get_addr (c : circuit_state RequestQueue) :=
+ let '(_,(_,(_,(_,(_,(_,_,_),_)),_,_,_,
+ (_,_),(_,(_,(_,_,_),_)),_,rda),wra)) := c in (rda,wra).
+
+ (* if address are the same -> modify the RequestQueue circuit : send back REQUEST_nil *)
+ (* if addresses are different -> step through the queue will read whatever is stored in rda
+ is that used in the circuit ? -> yes
+ cr will be taken from the queue when (Sidle /\ ~~ empty /\ Cprea)
+ *)
+
+ (* make a lemma for diff address
+ step RequestQueue c (true,c_req,pop) = (c',(f',MemRead@rda,p'))
+ *)
+
+ (* EMPTY OR NOT, data_o is always what is in rda *)
+
+ Lemma RequestQueue_equiv (c : circuit_state RequestQueue) c_req pop :
+ let '(rda,wra) := get_addr c in wra = rda -> exists c',
+ step RequestQueue c (true,c_req,pop) = (c',(false,REQUEST_NIL,true)).
+ Proof.
+ simpl in c; destruct_products.
+ rename t0 into rda, t into wra.
+ cbv [get_addr]; intros.
+ evar (c' : circuit_state RequestQueue); exists c'.
+ cbv [RequestQueue LoopInit fork2].
+ cbn [step fst snd].
+ simpl_ret.
+
+ specialize FullEmptyLogic_equiv with (c := (u15, (u17, u18, u16), u14)) (wra := wra) (rda := rda)
+ as Hequiv1; apply Hequiv1 in H as HH; clear Hequiv1; destruct HH as [cequiv1 Hequiv1].
+ rewrite Hequiv1.
+ cbn [fst snd bind inv and2 or2].
+
+ rewrite negb_false negb_true orbT.
+ rewrite andb_false_r andb_true_r.
+ Check memqueue.
+ rewrite ; simpl (true && true).
+
+ simpl (~~ false).
+ rewrite orbT.
+ progress autorewrite with simpl_ident.
+ simpl_ident.
+
+ simpl in cequiv1.
+ unfold cequiv1. cbn [cequiv1].
+ destruct_products.
+ fold (memqueue c _).
+ repeat destruct_pair_let. cbn [step].
+ Admitted.
+
+ Theorem SM_Eq (t : nat) (c_state : State_t) (f_req: Request_t)
+ (c_req : Bvector REQUEST_WIDTH) :
+ let f_state := (Default_arbitrate t).(Implementation_State) in
+ let R := Arrival_at t in
+ State_Eq f_state c_state -> EqArrival R c_req ->
+ let '(f_nextstate,_) := Next_state R f_state in
+ let '(c_nextstate,_) := step FIFOSM c_state (true,c_req) in
+ State_Eq f_nextstate c_nextstate.
+ Proof.
+ intros f_state R H Hreq; cbv [FIFOSM] in *.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
+ cbv [State_Eq get_st get_cnt get_cref get_wra get_rda get_cr] in H.
+ destruct (f_state) eqn:Hf_state.
+ { destruct R eqn:HR; [ admit (* impossible, contradicts Hreq *) | ].
+ destruct r eqn:HP.
+ { move: H => /andP [/andP [/andP [Hs Hc] Hcref] /eqP Haddr]; rewrite eq_refl in Haddr.
+ apply BVEq_eq in Hs,Hc,Hcref,Haddr.
+ subst s cnt cref wra.
+ cbv [LoopInit].
+ cbn [step fst snd].
+ cbv [ret monad CombinationalSemantics Identity.Monad_ident].
+ simpl_ident.
+ cbv [ret ].
+ destruct_pair_let.
+ (* Make a lemma to step through RequestQueue *)
+
+ }
+ }
+
+ (* Default arbitrate should be equal to the simulate function *)
+End EquivalenceProof.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Lib/CavaSM.v b/framework/CavaDRAM/Lib/CavaSM.v
index 32323ac..77f01b7 100644
--- a/framework/CavaDRAM/Lib/CavaSM.v
+++ b/framework/CavaDRAM/Lib/CavaSM.v
@@ -1,5 +1,5 @@
From CavaDRAM Require Import CavaReqQueue CavaUtil.
-From DRAM Require Import System.
+From CoqDRAM Require Import System.
From Coq Require Import BinaryString HexString NArith.
Module DataNotation.
diff --git a/framework/CavaDRAM/Lib/CavaSMProperties2.v b/framework/CavaDRAM/Lib/CavaSMProperties2.v
index a13d35c..5a637c9 100644
--- a/framework/CavaDRAM/Lib/CavaSMProperties2.v
+++ b/framework/CavaDRAM/Lib/CavaSMProperties2.v
@@ -110,7 +110,11 @@ Section CavaSMProperties2.
rewrite CavaPreludeProperties.eqb_refl.
rewrite fullAdder_cin leqnn N.sub_diag CavaPreludeProperties.eqb_neq.
2: { rewrite /FullVEC; simplify. admit. }
- instantiate (cs := (tt, (tt, tt, tt), tt)); unfold cs.
+ instantiate (cs := (tt, (tt, tt, tt), tt)); unfo(CavaPrelude.eqb
+ (let (x, _) :=
+ not_b <- Vec.inv rda;;
+ aV <- unpackV rda;; bV <- unpackV not_b;; col fullAdder one (vcombine aV bV) in
+ x, Vec.bitvec_literal (N2Bv_sized ADDR_WIDTH (N.of_nat QUEUE_MAX_SIZE - 1)))ld cs.
reflexivity.
Admitted.
diff --git a/framework/CavaDRAM/Lib/CavaSMbackup.v b/framework/CavaDRAM/Lib/CavaSMbackup.v
index 7c04f1f..8275535 100644
--- a/framework/CavaDRAM/Lib/CavaSMbackup.v
+++ b/framework/CavaDRAM/Lib/CavaSMbackup.v
@@ -4,7 +4,7 @@ From Coq Require Export Vectors.Fin Bool.Bool Program.Basics.
From CavaDRAM Require Export CavaReqQueue.
-From DRAM Require Export FIFO.
+From CoqDRAM Require Export FIFO.
Section CavaSM.
diff --git a/framework/CavaDRAM/Lib/CavaTactics.v b/framework/CavaDRAM/Lib/CavaTactics.v
index 6a2e86e..e9f52c4 100644
--- a/framework/CavaDRAM/Lib/CavaTactics.v
+++ b/framework/CavaDRAM/Lib/CavaTactics.v
@@ -17,4 +17,10 @@ Ltac simplify_step :=
| progress autorewrite with to_spec
| progress cbn [fst snd map] ].
-Ltac simplify := repeat simplify_step.
\ No newline at end of file
+Ltac simplify := repeat simplify_step.
+
+Ltac destruct_pair_let_ H :=
+ match goal with
+ | |- context [ match ?p with pair _ _ => _ end ] =>
+ rewrite (surjective_pairing p)
+ end.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Memory.v b/framework/CavaDRAM/Memory.v
new file mode 100644
index 0000000..04040ae
--- /dev/null
+++ b/framework/CavaDRAM/Memory.v
@@ -0,0 +1,293 @@
+Require Import String NArith PeanoNat Bvector ssreflect.
+Require BinaryString Vectors.VectorDef Coq.Arith.Compare.
+Global Open Scope string_scope.
+
+Require Import ExtLib.Structures.Monad.
+From Cava Require Import Core Semantics.Simulation Semantics.Combinational Util.Tactics.
+From Cava.Lib Require Vec.
+From Cava.Lib Require Import CavaPrelude Combinators Multiplexers Decoder DecoderProperties CombinatorsProperties.
+
+Import MonadNotation Circuit.Notations Init.Logic.EqNotations.
+Global Open Scope monad_scope.
+
+Require Import CavaDRAM.Util CavaDRAM.Step.
+
+Section WithCava.
+ Context `{semantics : Cava}.
+
+ (* write data * write enable -> read data*)
+ Definition mem_cell T I :=
+ DelayInitCE (t := T) I.
+
+ (* read data vector * write data * write enable * read data -> read data vector *)
+ Definition mem_combine {M N} T (H : S M = N) :=
+ Comb (
+ fun (input : signal (Vec T M) * (signal T * signal Bit * signal T)) =>
+ let '(rdV, (wd, we, rd)) := input in
+ v <- mux2 we (rd, wd);;
+ x <- Vec.shiftin v rdV;;
+ r <- Util.vec_cast T H x;;
+ ret r
+ ).
+
+ (* write data * write enable vector -> write data * write enable *)
+ Definition mem_we T W N :=
+ Comb (
+ fun input : signal T * signal (Vec Bit (2^W)) =>
+ let '(wd, weV) := input in
+ we <- indexConst weV (N-1);;
+ ret (wd, we)
+ ).
+
+ (* write data * write enable vector -> read data vector *)
+ Fixpoint mem_cells T W N I: (Circuit (signal T * signal (Vec Bit (2^W))) (signal (Vec T N))) :=
+ match N as X return X = N -> _ with
+ | 0 =>
+ fun H =>
+ Comb (fun x =>
+ r <- Vec.nil;;
+ x <- (Util.vec_cast T H r);;
+ ret x
+ )
+ | S N' =>
+ fun H =>
+ Comb(fork2)
+ >==> First (mem_cells T W N' I)
+ >==> Second (mem_we T W N >==> Comb(fork2) >==> Second (mem_cell T (I N')))
+ >==> mem_combine T H
+ end Logic.eq_refl.
+
+ (* write data * write address * write enable -> write data * write enable vector *)
+ Definition mem_write T W :=
+ Comb (
+ fun input : signal T * signal (Vec Bit W) * signal Bit =>
+ let '(wd, wa, we) := input in
+ weV <- Util.decode we wa;;
+ ret (wd, weV)
+ ).
+
+ (* read address * read data vecor -> read data *)
+ Definition mem_read T W N P (PP : nat) :=
+ Comb (
+ fun input : signal (Vec (Vec Bit W) P) * signal (Vec T N) =>
+ '(rdAV, rdV) <- input;;
+ rdA <- indexConst rdAV PP;;
+ indexAt rdV rdA
+ ).
+
+ Definition mem_read_combine {M N} T (H : S M = N) :=
+ Comb (
+ fun (input : signal (Vec T M) * (signal T)) =>
+ let '(rdV, rd) := input in
+ x <- Vec.shiftin rd rdV;;
+ r <- Util.vec_cast T H x;;
+ ret r
+ ).
+
+ Fixpoint mem_reads T W N P PP : (Circuit (signal (Vec (Vec Bit W) P) * signal (Vec T N)) (signal (Vec T PP))) :=
+ match PP as X return X = PP -> _ with
+ | 0 =>
+ fun H =>
+ Comb (fun x =>
+ r <- Vec.nil;;
+ x <- (Util.vec_cast T H r);;
+ ret x
+ )
+ | S PP' =>
+ fun H =>
+ Comb(fork2)
+ >==> First (mem_reads T W N P PP')
+ >==> Second (mem_read T W N P PP')
+ >==> mem_read_combine T H
+ end Logic.eq_refl.
+
+ (* read addresses * write data * write address * write enable -> read data
+ T: type of memory cell contents (Vec 32)
+ W: address width in bits
+ P: number of read ports
+ I: initial content of memory
+ *)
+ (* Second (mem_write T W >==> mem_cells T W (2^W) I). >==> mem_read T W (2^W) P 1). *)
+
+ Definition Memory T W P I :=
+ Second (mem_write T W >==> mem_cells T W (2^W) I) >==> mem_reads T W (2^W) P P.
+
+ Definition Memory' T W P I :=
+ Second (mem_write T W >==> mem_cells T W (2^W) I) >==> mem_read T W (2^W) P 0.
+
+End WithCava.
+
+Module Test.
+ Import ListNotations Vector.VectorNotations.
+ Import Cava.Semantics.Simulation.
+
+ Definition Test_input1 := [
+ ([N2Bv_sized 3 0; N2Bv_sized 3 2]%vector, (N2Bv_sized 2 0, N2Bv_sized 3 0, false));
+ ([N2Bv_sized 3 1; N2Bv_sized 3 3]%vector, (N2Bv_sized 2 0, N2Bv_sized 3 0, false));
+ ([N2Bv_sized 3 2; N2Bv_sized 3 0]%vector, (N2Bv_sized 2 0, N2Bv_sized 3 0, false));
+ ([N2Bv_sized 3 3; N2Bv_sized 3 1]%vector, (N2Bv_sized 2 0, N2Bv_sized 3 0, false))
+ ]%list.
+
+ Definition Test_result1 :=
+ [
+ [0%N; 2%N]%vector;
+ [1%N; 3%N]%vector;
+ [2%N; 0%N]%vector;
+ [3%N; 1%N]%vector
+ ]%list.
+
+ (* Initializes the memory content with the address *)
+ Definition Init1 (n : nat):=
+ N2Bv_sized 2 (N.of_nat n).
+
+ Definition Test_run1 :=
+ map (Vector.map Bv2N) (simulate (Memory (Vec Bit 2) 3 2 Init1) Test_input1).
+
+ Lemma Test: Test_run1 = Test_result1.
+ Proof.
+ reflexivity.
+ Qed.
+
+ Definition Test_input2 :=
+ [
+ (* writes 0 at @0, reads @0 := 0 and @3 := 0 *)
+ ([N2Bv_sized 3 0; N2Bv_sized 3 3]%vector, (N2Bv_sized 2 0, N2Bv_sized 3 0, true));
+ (* writes 1 at @1, reads @1 := 1 and @2 := 1 *)
+ ([N2Bv_sized 3 1; N2Bv_sized 3 2]%vector, (N2Bv_sized 2 1, N2Bv_sized 3 1, true));
+ (* writes 2 at @2, reads @2 := 2 and @1 := 1*)
+ ([N2Bv_sized 3 2; N2Bv_sized 3 1]%vector, (N2Bv_sized 2 2, N2Bv_sized 3 2, true));
+ ([N2Bv_sized 3 3; N2Bv_sized 3 0]%vector, (N2Bv_sized 2 3, N2Bv_sized 3 3, true));
+ ([N2Bv_sized 3 0; N2Bv_sized 3 3]%vector, (N2Bv_sized 2 2, N2Bv_sized 3 1, false));
+ ([N2Bv_sized 3 1; N2Bv_sized 3 2]%vector, (N2Bv_sized 2 2, N2Bv_sized 3 1, false));
+ ([N2Bv_sized 3 2; N2Bv_sized 3 1]%vector, (N2Bv_sized 2 2, N2Bv_sized 3 1, false));
+ ([N2Bv_sized 3 3; N2Bv_sized 3 0]%vector, (N2Bv_sized 2 2, N2Bv_sized 3 1, false))
+ ]%list.
+
+ Definition Init2 (n : nat):=
+ N2Bv_sized 2 (N.of_nat (3-n)).
+
+ Definition Test_run2 :=
+ map (Vector.map Bv2N) (simulate (Memory (Vec Bit 2) 3 2 Init2) Test_input2).
+
+ Definition Test_result2 :=
+ [
+ [0%N; 0%N]%vector;
+ [1%N; 1%N]%vector;
+ [2%N; 1%N]%vector;
+ [3%N; 0%N]%vector;
+ [0%N; 3%N]%vector;
+ [1%N; 2%N]%vector;
+ [2%N; 1%N]%vector;
+ [3%N; 0%N]%vector
+ ]%list.
+
+ Lemma Test2 : Test_run2 = Test_result2.
+ reflexivity.
+ Qed.
+End Test.
+
+Module Properties.
+
+ Definition Cells_state_prod {T W N M I} (H : N = S M) (r : circuit_state (mem_cells T W N I)) :
+ (unit * circuit_state (mem_cells T W M I) * (unit * unit * circuit_state (mem_cell T (I N))) * unit)%type.
+ Proof.
+ destruct N.
+ - discriminate H.
+ - rewrite H in r; simpl in r; exact r.
+ Defined.
+
+ Fixpoint Cells_data {T W N I} (S : circuit_state (mem_cells T W N I)) : Vector.t (combType T) N :=
+ match N as X return N = X -> X = N -> _ with
+ | 0%nat =>
+ fun H H' =>
+ Vector.nil (combType T)
+ | S N' =>
+ fun H H'=>
+ let '(_, s', (_, _, v), _) := Cells_state_prod H S in
+ let r := Cells_data s' in
+ Vector.shiftin v r
+ end Logic.eq_refl Logic.eq_refl.
+
+ Fixpoint Cells_read {T W N I} we wa wd (S : circuit_state (mem_cells T W N I)) : Vector.t (combType T) N :=
+ match N as X return N = X -> X = N -> _ with
+ | 0%nat =>
+ fun H H' =>
+ Vector.nil (combType T)
+ | S N' =>
+ fun H H'=>
+ let '(_, s', (_, _, v), _) := Cells_state_prod H S in
+ let r := Cells_read we wa wd s' in
+ if ((wa =? N') && we)%nat then Vector.shiftin wd r
+ else Vector.shiftin v r
+ end Logic.eq_refl Logic.eq_refl.
+
+ (* cells data won't change if not writing *)
+ Lemma Cells_const {T W N I} (S : circuit_state (mem_cells T W N I)) wd we:
+ (forall n, indexConst we n = constant false) ->
+ Cells_data S = Cells_data (fst (step (mem_cells T W N I) S (wd, we))).
+ Proof.
+ intros Hwe.
+ induction N.
+ - reflexivity.
+ - unfold mem_cells; fold mem_cells; unfold mem_cell.
+ repeat step_destruct.
+ rewrite (surjective_pairing (step (mem_cells _ _ _ _) SC3 _)) /=.
+ rewrite Hwe (surjective_pairing SC2) (surjective_pairing (fst SC2)) IHN.
+ reflexivity.
+ Qed.
+
+ (* Other parts of the memory do not change *)
+ Lemma Cells_match {T W N I} (S : circuit_state (mem_cells T W N I)) wd wa we wev:
+ (forall n, (wa =? n)%nat = false ->
+ indexConst wev n = constant false) ->
+ indexConst wev wa = constant we ->
+ Cells_read we wa wd S = Cells_read we wa wd (fst (step (mem_cells T W N I) S (wd, wev))).
+ Proof.
+ intros Hwde Hwe.
+ induction N.
+ - reflexivity.
+ - unfold mem_cells; fold mem_cells; unfold mem_cell.
+ repeat step_destruct.
+ rewrite (surjective_pairing (step (mem_cells _ _ _ _) SC3 _)) /=.
+ rewrite (surjective_pairing SC2) (surjective_pairing (fst SC2)) IHN.
+ destruct (wa =? N)%nat eqn:Hwa, we.
+ + move : Hwa => /Nat.eqb_eq Hwa; subst N; reflexivity.
+ + move : Hwa => /Nat.eqb_eq Hwa; subst N; rewrite Nat.sub_0_r Hwe; reflexivity.
+ + rewrite Nat.sub_0_r (Hwde N Hwa); reflexivity.
+ + rewrite Nat.sub_0_r (Hwde N Hwa); reflexivity.
+ Qed.
+
+ Lemma Cells_matchX {T W N I} (S : circuit_state (mem_cells T W N I)) wd wa we wev:
+ (forall n, (wa =? n)%nat = false -> indexConst wev n = constant false) ->
+ indexConst wev wa = constant we ->
+ Cells_read we wa wd S = Cells_data (fst (step (mem_cells T W N I) S (wd, wev))).
+ Proof.
+ intros Hwde Hwe.
+ induction N.
+ - reflexivity.
+ - unfold mem_cells; fold mem_cells; unfold mem_cell.
+ repeat step_destruct.
+ rewrite (surjective_pairing (step (mem_cells _ _ _ _) SC3 _)) /=.
+ rewrite (surjective_pairing SC2) (surjective_pairing (fst SC2)) IHN.
+ destruct (wa =? N)%nat eqn:Hwa, we.
+ + move : Hwa => /Nat.eqb_eq Hwa; subst N; rewrite Nat.sub_0_r Hwe; reflexivity.
+ + move : Hwa => /Nat.eqb_eq Hwa; subst N; rewrite Nat.sub_0_r Hwe; reflexivity.
+ + rewrite Nat.sub_0_r (Hwde N Hwa); reflexivity.
+ + rewrite Nat.sub_0_r (Hwde N Hwa); reflexivity.
+ Qed.
+
+ (* Fixpoint Mem_read {T W PP} (md : Vector.t (combType T) (2^W)) (rav : VectorDef.t (Bvector W) PP) :=
+ match PP as X return PP = X -> _ with
+ | 0 =>
+ fun H =>
+ Vector.nil (combType T)
+ | S PP' =>
+ fun H =>
+ let rav := Vector.cast rav H in
+ let r := Mem_read md (Vector.tl rav) in
+ let i := Bv2Fin (Vector.hd rav) in
+ let v := Vector.nth md i in
+ Vector.shiftin v r
+ end Logic.eq_refl. *)
+
+End Properties.
diff --git a/framework/CavaDRAM/README_extraction.md b/framework/CavaDRAM/README_extraction.md
new file mode 100644
index 0000000..ba2677b
--- /dev/null
+++ b/framework/CavaDRAM/README_extraction.md
@@ -0,0 +1,9 @@
+## Performing extraction
+
+- CavaSMExtraction has to be in _CoqProject, this will generate every haskell file from Coq files
+
+- I added the Data.Char and Data.Bits in two files where they were needed (should be automatic)
+
+- The script 'cava2sv.sh' will use ghc to compile the top-level 'CavaFIFOSV.hs', which will on its turn call the haskell function 'writeSystemVerilog' from the Cava library. The compiled program will produce a program.
+
+- Executing ./CavaFIFOSV will generate SystemVerilog code.
\ No newline at end of file
diff --git a/framework/CavaDRAM/Step.v b/framework/CavaDRAM/Step.v
new file mode 100644
index 0000000..ddde91f
--- /dev/null
+++ b/framework/CavaDRAM/Step.v
@@ -0,0 +1,97 @@
+Set Printing Projections.
+Require Import String NArith PeanoNat Bvector Vectors.Vector ssreflect.
+Require BinaryString Vectors.Vector Coq.Arith.Compare ZArith.BinInt.
+Global Open Scope string_scope.
+
+Require Import ExtLib.Structures.Monad.
+Require Import Cava.Core.Core Cava.Semantics.Simulation Cava.Semantics.Combinational Cava.Util.Tactics.
+From Cava.Lib Require Vec.
+From Cava.Lib Require Import CavaPrelude Combinators.
+
+Import MonadNotation Circuit.Notations Init.Logic.EqNotations.
+Open Scope monad_scope.
+
+Open Scope vector_scope.
+
+Lemma step_compose {I M O} (c1 : Circuit I M) (c2 : Circuit M O) i cs :
+ step (Compose c1 c2) cs i = let (sc1, o1) := (step c1 (fst cs) i) in
+ let (sc2, o2) := (step c2 (snd cs) o1) in (sc1, sc2, o2).
+Proof.
+ simpl; repeat destruct (step _ _ _); reflexivity.
+Qed.
+
+Lemma step_comb {I O} (f : I -> O) i (cs : circuit_state (Comb f)):
+ step (Comb f) cs i = (tt, f i).
+Proof.
+ reflexivity.
+Qed.
+
+Lemma step_second {I T O} (i : T * I) (c : Circuit I O) (cs : circuit_state (Second c)):
+ step (Second c) cs i = let '(cs', x) := step c cs (snd i) in (cs', (fst i, x)).
+Proof.
+ simpl in cs.
+ reflexivity.
+Qed.
+
+Lemma step_first {I T O} (i : I * T) (c : Circuit I O) (cs : circuit_state (First c)):
+ step (First c) cs i = let '(cs', x) := step c cs (fst i) in (cs', (x, snd i)).
+Proof.
+ simpl in cs.
+ reflexivity.
+Qed.
+
+Lemma step_loop {I O S} (c : Circuit (I * (combType S)) (O * (combType S))) cs i r:
+ step (LoopInitCE r c) cs i =
+ let '(cs', (out, v')) := step c (fst cs) (fst i, snd cs) in
+ let new_state := if snd i then v' else snd cs in
+ (cs', new_state, out).
+Proof.
+ destruct i, cs.
+ reflexivity.
+Qed.
+
+Ltac destruct_state S :=
+ try lazymatch S with
+ | fst (pair ?a ?b) =>
+ simpl (snd (pair ?a ?b))
+ | snd (pair ?a ?b) =>
+ simpl (snd (pair ?a ?b))
+ | fst ?S =>
+ let S' := fresh "Sf" in destruct S eqn:S'
+ | snd ?S =>
+ let S' := fresh "Ss" in destruct S eqn:S'
+ | ?S =>
+ let S1 := fresh "SC" in
+ let S2 := fresh "SC" in
+ destruct S as [S1 S2];
+ simpl (fst (S1, S2));
+ simpl (snd (S1, S2))
+ | ?S =>
+ let S' := fresh "SS" in
+ destruct S as S'
+ end.
+
+Ltac my_simpl :=
+ unfold fork2;
+ lazymatch goal with
+ | |- context [fst (ret (?a, ?b))] =>
+ simpl (fst (ret (a, b)))
+ | |- context [snd (ret (?a, ?b))] =>
+ simpl (snd (ret (a, b)))
+ end.
+
+Ltac step_destruct :=
+ unfold LoopInit, Loop;
+ repeat my_simpl;
+ match goal with
+ | |- context [step (Comb _) ?S _] =>
+ rewrite step_comb
+ | |- context [step (Compose _ _) ?S _] =>
+ rewrite step_compose; destruct_state S
+ | |- context [step (LoopInitCE _ _) ?S _] =>
+ rewrite step_loop; destruct_state S
+ | |- context [step (First _) ?S _] =>
+ rewrite step_first; destruct_state S
+ | |- context [step (Second _) ?S _] =>
+ rewrite step_second; destruct_state S
+ end; repeat my_simpl.
diff --git a/framework/CavaDRAM/Util.v b/framework/CavaDRAM/Util.v
new file mode 100644
index 0000000..7573b02
--- /dev/null
+++ b/framework/CavaDRAM/Util.v
@@ -0,0 +1,154 @@
+Set Printing Projections.
+Set Warnings "-notation-overridden,-parsing".
+
+From Coq Require Import String NArith PeanoNat Bvector ssreflect.
+Require BinaryString Vectors.Vector Coq.Arith.Compare.
+Global Open Scope string_scope.
+
+Require Import ExtLib.Structures.Monad.
+Require Import Cava.Core.Core Cava.Semantics.Simulation.
+From Cava.Lib Require Vec.
+From Cava.Lib Require Import CavaPrelude Combinators Multiplexers Decoder Adders.
+Import MonadNotation Circuit.Notations Init.Logic.EqNotations.
+Global Open Scope monad_scope.
+
+Section WithCava.
+ Context `{semantics : Cava}.
+ Definition bin_constant w (s : String.string) : signal (Vec Bit w) :=
+ Vec.of_N (n := w) (BinaryString.Raw.to_N s 0).
+
+ Definition computational_eq {m n} (opaque_eq: m = n) : m = n :=
+ match Nat.eq_dec m n with
+ | left transparent_eq => transparent_eq
+ | _ => opaque_eq (* dead code; could use [False_rect] *)
+ end.
+
+ Lemma computational_eq_eq {m n} (H : m = n):
+ computational_eq H = H.
+ Proof.
+ unfold computational_eq.
+ apply Logic.Eqdep_dec.UIP_dec.
+ apply Nat.eq_dec.
+ Qed.
+
+ Definition vec_cast {n m} (T : SignalType) (H : n = m) (x : signal (Vec T n)) : cava (signal (Vec T m)) :=
+ localSignal (rew [fun n0 : nat => signal (Vec T n0)] (computational_eq H) in x).
+
+ Definition vec_extend {A} {m n} {H : m + (n - m) = n} (s : signal A) (v : signal (Vec A m)) : cava (signal (Vec A n)) :=
+ lo <- unpackV v;;
+ hi <- Vector.const s (n - m);;
+ va <- packV (Vector.append lo hi);;
+ r <- (vec_cast A H va);;
+ ret r.
+
+ Program Definition vec_trunc {A} {m n} {H : n <= m} (v : signal (Vec A m)) : cava (signal (Vec A n)) :=
+ v' <- unpackV v;;
+ r <- Vectors.Vector.take n H v';;
+ packV r.
+
+ Definition vec_extract_const {A} {s l n : nat} (H : (s + l) <= n) (v : signal (Vec A n)) : cava (signal (Vec A l)) :=
+ r <- unpackV (signal := signal) v;;
+ r <- Vectors.Vector.take (s+l) H r;;
+ r <- snd (Vectors.Vector.splitat s r);;
+ packV r.
+
+ Program Definition vec_concat {A} {m n} (hi : signal (Vec A m)) (lo : signal (Vec A n)) : cava (signal (Vec A (n + m))) :=
+ hi <- unpackV hi;;
+ lo <- unpackV lo;;
+ va <- packV (Vector.append lo hi);;
+ ret va.
+
+ Lemma decode_n {m n} (H : S n = m): 2^n + 2^n = 2^m.
+ Proof.
+ rewrite -H /= Nat.add_0_r.
+ reflexivity.
+ Defined.
+
+ Lemma decode_zero {n} (H : 0 = n): 1 = 2^n.
+ Proof.
+ rewrite -H; reflexivity.
+ Defined.
+
+ Lemma decode_one {m n} (H : S n = m) (H1 : 0 = n): 2 = 2^m.
+ Proof.
+ rewrite -H -H1; reflexivity.
+ Defined.
+
+ Fixpoint decode_ {N} (en : signal Bit) (x : signal (Vec Bit N)) {struct N} : cava (signal (Vec Bit (2^N))) :=
+ match N as X return X = N -> _ with
+ | 0 =>
+ fun H =>
+ r <- Vec.const en 1;;
+ r <- vec_cast Bit (decode_zero H) r;;
+ ret r
+ | S N' =>
+ fun H =>
+ match N' as X1 return X1 = N' -> _ with
+ | 0 =>
+ fun H1 =>
+ x <- vec_cast _ (eq_sym H) x;;
+ hs <- Vec.hd x;;
+ ls <- inv hs;;
+ lo <- and2(en, ls);;
+ hi <- and2(en, hs);;
+ r <- Vec.const hi 1;;
+ r <- Vec.cons lo r;;
+ r <- vec_cast Bit (decode_one H H1) r;;
+ ret r
+ | S N'' =>
+ fun H1 =>
+ x <- vec_cast _ (eq_sym H) x;;
+ t <- Vec.tl x;;
+ hs <- Vec.hd x;;
+ ls <- inv hs;;
+ len <- and2 (en, ls);;
+ hen <- and2 (en, hs);;
+ lo <- decode_ len t;;
+ hi <- decode_ hen t;;
+ r <- vec_concat hi lo;;
+ r <- vec_cast _ (decode_n H) r;;
+ ret r
+ end Logic.eq_refl
+ end Logic.eq_refl.
+
+ Definition decode {N} (en : signal Bit) (x : signal (Vec Bit N)) : cava (signal (Vec Bit (2^N))) :=
+ v' <- Vec.rev x;;
+ decode_ en v'.
+
+
+ Fixpoint Bv2Nat {N} (bv : Bvector N) : nat :=
+ match bv with
+ | Vector.nil _ => 0%nat
+ | Vector.cons _ false _ bv' => 2 * (Bv2Nat bv')
+ | Vector.cons _ true _ bv' => S (2 * (Bv2Nat bv'))
+ end.
+
+ Lemma Bv2Nat_upper_bound {N} (bv : Bvector N) :
+ ((Bv2Nat bv) < 2^N)%nat.
+ Proof.
+ induction bv.
+ { simpl; exact Nat.lt_0_1. }
+ { simpl. rewrite !Nat.add_0_r; destruct h.
+ { rewrite -Nat.add_succ_r. apply Nat.add_lt_le_mono.
+ { exact IHbv. }
+ { apply Lt.lt_le_S;exact IHbv. }
+ }
+ { apply Plus.plus_lt_compat; exact IHbv. }
+ }
+ Qed.
+
+ Definition Bv2Fin {N} (v : Bvector N) : Fin.t (2^N).
+ specialize (Bv2Nat_upper_bound v) as H.
+ exact (Fin.of_nat_lt H).
+ Defined.
+
+End WithCava.
+
+(* get rid of the reverse *)
+(* Section Properties.
+
+ Context `{semantics : Cava}.
+
+ Print Instances Cava.
+ Lemma test (n : nat) (t : cava (signal (Vec Bit n))):
+ indexConst (decode one t) n = zero. *)
diff --git a/framework/CavaDRAM/UtilSM.v b/framework/CavaDRAM/UtilSM.v
new file mode 100644
index 0000000..3adaebd
--- /dev/null
+++ b/framework/CavaDRAM/UtilSM.v
@@ -0,0 +1,326 @@
+From CavaDRAM Require Import Memory Step.
+From Coq Require Import Program BinaryString HexString NArith.
+From Cava Require Import Cava CavaProperties Util.Vector.
+From mathcomp Require Import fintype ssrZ zify ring.
+From mathcomp Require Import ssreflect ssrnat ssrbool eqtype.
+
+Ltac simpl_ret := cbv [ret bind monad CombinationalSemantics Identity.Monad_ident].
+Ltac simpl_ret_H H := cbv [ret bind monad CombinationalSemantics Identity.Monad_ident] in H.
+
+Ltac fast_simpl_bool :=
+ repeat lazymatch goal with
+ | |- context [(~~ _)] => vm_compute (~~ _)
+ | |- context [(andb false _)] => vm_compute (andb false _)
+ | |- context [(andb _ false)] => vm_compute (andb _ false)
+ | |- context [(orb _ true)] => vm_compute (orb _ true)
+ | |- context [(andb true true)] => vm_compute (andb true true)
+ end.
+
+Section WithCava.
+
+ Lemma mulnP x y:
+ Nat.mul x y = muln x y.
+ Proof. auto. Qed.
+
+ Lemma add_1_sub1 (x : N):
+ (0 < x)%N -> N.add (N.sub x 1) 1 = x.
+ Proof. lia. Qed.
+
+ Lemma leq_Nle (a b : N) :
+ leq (nat_of_bin a) (nat_of_bin b) -> (a <= b)%N.
+ Proof. lia. Qed.
+
+ Lemma ltn_Ntn (a b : N) :
+ leq (S (nat_of_bin a)) (nat_of_bin b) -> (a < b)%N.
+ Proof. lia. Qed.
+
+ Lemma log2_eq1_pw2 (n : nat) :
+ Nat.pow 2 (Nat.log2 n) = n ->
+ Nat.log2 n = 1 -> n = 2.
+ Proof. intros; by rewrite H0 in H. Qed.
+
+ Lemma lt_trans_le (n m p : N):
+ (m < n)%N -> (n < p)%N -> (m + 1 < p)%N.
+ Proof. lia. Qed.
+
+ Lemma of_nat_neq (a b : nat) :
+ a <> b <-> (N.of_nat a <> N.of_nat b).
+ Proof.
+ intros; split;
+ specialize Nat2N.inj_iff with (n := a) (n' := b) as HH; by rewrite HH.
+ Qed.
+
+ Lemma ltn_mul_add1 a b:
+ a < b -> 2 * a + 1 < 2 * b.
+ Proof. lia. Qed.
+
+ Lemma of_nat_add_double z:
+ N.of_nat (z + z)%coq_nat = N.double (N.of_nat z).
+ Proof.
+ rewrite -Nat2N.inj_double; apply Nat2N.inj_iff; lia.
+ Qed.
+
+ Lemma to_nat_lt_of_nat (a : N) (n : nat) :
+ N.to_nat a < n -> N.lt a (N.of_nat n).
+ Proof.
+ intros.
+ induction n; [ discriminate | ].
+ rewrite leq_eqVlt in H; move: H => /orP [/eqP H | H].
+ { rewrite -H Nat2N.inj_succ N2Nat.id; by specialize (N.lt_succ_diag_r a). }
+ assert (N.to_nat a < n).
+ { specialize (ltn_add2r 1 (N.to_nat a) n) as S; rewrite !addn1 in S; by rewrite S in H. }
+ apply IHn in H0.
+ apply N.lt_trans with (m := N.of_nat n); [ done | ].
+ rewrite Nat2N.inj_succ; by specialize (N.lt_succ_diag_r (N.of_nat n)).
+ Qed.
+
+ Lemma to_nat_lt_pow a b:
+ N.to_nat a < Nat.pow 2 b ->
+ N.lt a (2 ^ N.of_nat b).
+ Proof.
+ intros; apply to_nat_lt_of_nat in H.
+ rewrite -Nat2N.inj_pow in H.
+ by simpl (N.of_nat 2) in H.
+ Qed.
+
+ Lemma predN_of_succ_nat (n : N) :
+ Pos.pred_N (Pos.of_succ_nat (N.to_nat n)) = n.
+ Proof.
+ induction n; [ by simpl | ].
+ have s := (Pnat.Pos2SuccNat.id_succ p).
+ by rewrite Znat.positive_N_nat s Pos.pred_N_succ.
+ Qed.
+
+ Lemma nth_0 {T} (def : T) (vec : Vector.t T 1) :
+ (nth_default def 0 vec) = Vector.hd vec.
+ Proof.
+ by rewrite nth_default_to_list -nth_hd (Vector.eta vec).
+ Qed.
+
+ (* -------------------------- vector proofs -------------------- *)
+ Lemma eqb_iff_neq {t} (x y : combType t) : CavaPrelude.eqb (x, y) = false -> x <> y.
+ Proof.
+ by intros; rewrite -CavaPreludeProperties.eqb_eq H.
+ Qed.
+
+ Lemma length_to_list_shiftin {A N} (v : Vector.t A N) (e : A) :
+ Datatypes.length (Vector.to_list (Vector.shiftin e v)) = N + 1.
+ Proof.
+ induction v; [ rewrite //= | ].
+ unfold Vector.shiftin; fold @Vector.shiftin.
+ rewrite to_list_cons cons_length IHv; lia.
+ Qed.
+
+ Lemma last_shiftin {A N} (v : Vector.t A N) (def e : A) :
+ last (Vector.to_list (Vector.shiftin e v)) def = e.
+ Proof.
+ induction v; [ rewrite //= | ].
+ unfold Vector.shiftin; fold @Vector.shiftin.
+ rewrite to_list_cons //=.
+ destruct (Vector.to_list (Vector.shiftin e v)) eqn:Hbug;
+ [ contradict Hbug; induction v; simpl; done | ].
+ done.
+ Qed.
+
+ Import Memory.Properties BvectorNotations.
+ Open Scope Bvector_scope.
+
+ Lemma Bv2N_upper_bound_nat {n : nat} (bv : Bvector n) :
+ (N.to_nat (Bv2N bv) < (Nat.pow 2 n)).
+ Proof.
+ induction bv; [ by simpl | ]; destruct h; rewrite Bv2N_cons.
+ { rewrite N.succ_double_spec.
+ set z := Bv2N _; fold z in IHbv.
+ rewrite N2Nat.inj_add N2Nat.inj_mul.
+ vm_compute (N.to_nat 1); vm_compute (N.to_nat 2).
+ assert ((2 * N.to_nat z)%coq_nat = (2 * N.to_nat z)%nat); try done; rewrite H; clear H.
+ assert ((2 * N.to_nat z + 1)%coq_nat = (2 * N.to_nat z + 1)%nat); try done; rewrite H; clear H.
+ apply ltn_mul_add1 in IHbv.
+ rewrite Nat.pow_succ_r; [ | apply /leP; by rewrite leq0n ].
+ assert ((2 * (2 ^ n))%coq_nat = (2 * (2 ^ n))%nat); try done; rewrite H; clear H. }
+ { rewrite N.double_spec N2Nat.inj_mul; set z := Bv2N _; fold z in IHbv; vm_compute (N.to_nat 2).
+ assert ((2 * N.to_nat z)%coq_nat = (2 * N.to_nat z)%nat); try done; rewrite H; clear H.
+ have aux : (0 < 2); [ done | ].
+ have H := (ltn_pmul2l aux); rewrite -H in IHbv.
+ rewrite Nat.pow_succ_r; [ | apply /leP; by rewrite leq0n ]; clear H.
+ assert ((2 * (2 ^ n))%coq_nat = (2 * (2 ^ n))%nat); try done; rewrite H; clear H.
+ }
+ Qed.
+
+ Lemma size_nat_sub_leq {n} (a b : Bvector n):
+ N.le (Bv2N b) (Bv2N a) ->
+ N.size_nat (Bv2N a - Bv2N b) <= n.
+ Proof.
+ intros; apply /leP; apply N.size_nat_le.
+ specialize (@Bv2N_upper_bound_nat n a) as Ha.
+ specialize (@Bv2N_upper_bound_nat n b) as Hb.
+ destruct (Bv2N b) eqn:Hb0, (Bv2N a) eqn:Ha0; try discriminate.
+ { simpl in *. by apply to_nat_lt_pow. }
+ { rewrite N.sub_0_r; by apply to_nat_lt_pow in Ha. }
+ { by contradict H. }
+ { apply to_nat_lt_pow in Ha,Hb.
+ apply (N.lt_trans (N.pos p0 - N.pos p) (N.pos p0) (N.pow 2 (N.of_nat n))); [ | done].
+ apply N.sub_lt; done.
+ }
+ Qed.
+
+ Lemma Bv_eq_translation {n} (a b : Bvector n) :
+ (nat_of_bin (Bv2N a) = nat_of_bin (Bv2N b)) ->
+ (Bv2N a = Bv2N b)%N.
+ Proof. lia. Qed.
+
+ Lemma Bv_ltn_translation {n} (a b : Bvector n) :
+ (nat_of_bin (Bv2N a) < nat_of_bin (Bv2N b)) ->
+ (Bv2N a < Bv2N b)%N.
+ Proof. lia. Qed.
+
+ Lemma BVEq_iff_eq {N} (a b : Bvector N) :
+ (a =? b) = true <-> a = b.
+ Proof.
+ split; intros.
+ { specialize VectorEq.eqb_eq with (A_beq := Bool.eqb) (v1 := a) (v2 := b) as HH.
+ unfold BVeq in H.
+ apply HH in H; [exact H | exact Bool.eqb_true_iff ].
+ }
+ unfold BVeq.
+ apply VectorEq.eqb_eq; [exact Bool.eqb_true_iff | exact H ].
+ Qed.
+
+ Lemma BVEq_iff_neq {N} (a b : Bvector N) :
+ (a =? b) = false <-> a <> b.
+ Proof.
+ split; intros.
+ { rewrite <- BVEq_iff_eq.
+ destruct (a =? b) eqn:Heq; done. }
+ destruct (a =? b) eqn:Heq; [ | done].
+ apply BVEq_iff_eq in Heq; by rewrite Heq in H.
+ Qed.
+
+ Lemma BV_neq_cons {n} (a : bool) (x y: Bvector n) :
+ x <> y -> ((a :: x)%vector) <> ((a :: y) %vector).
+ Proof.
+ intros; rewrite -(VectorEq.eqb_eq bool Bool.eqb) //=; [ | exact Bool.eqb_true_iff].
+ rewrite eqb_reflx andb_true_l.
+ apply BVEq_iff_neq in H.
+ rewrite /BVeq in H; by rewrite H.
+ Qed.
+
+ Lemma bv_neq_sym {n} (a b : Vector.t bool n):
+ a <> b -> b <> a.
+ Admitted.
+
+ Lemma N2Bv_sized_N2Bv_sized_p1 x y n:
+ N2Bv_sized n x <> N2Bv_sized n y ->
+ N2Bv_sized n.+1 x <> N2Bv_sized n.+1 y.
+ Proof.
+ intros.
+ destruct x,y; simpl; intros; try done;
+ destruct p eqn:hp; simpl; try done; try destruct p0; try done; apply BV_neq_cons.
+ all: try apply P2Bv_nonzero; simpl.
+ all: try apply bv_neq_sym.
+ all: try apply P2Bv_nonzero; simpl.
+ Admitted.
+
+ (* Should follow from N2Bv_sized_neq_iff *)
+ Lemma N2Bv_sized_neq_succ (n : nat) (x : N) :
+ n > 0 -> N2Bv_sized n (N.succ x) <> N2Bv_sized n x.
+ Proof.
+ intros Hgt0; induction n; [by [] | ].
+ rewrite ltnS leq_eqVlt in Hgt0; move: Hgt0 => /orP [/eqP Heq0 | Hgt0].
+ { rewrite -Heq0; destruct x; try destruct p; simpl; done. }
+ apply IHn in Hgt0; by apply N2Bv_sized_N2Bv_sized_p1.
+ Qed.
+
+ Lemma N2Bv_sized_eq_p1_false {W} (v : Bvector W):
+ W > 0 -> N2Bv_sized W (Bv2N v + 1) =? v = false.
+ Proof.
+ intros; apply BVEq_iff_neq.
+ rewrite N.add_1_r.
+ specialize (N2Bv_sized_Bv2N W v) as H0; rewrite -{2}H0.
+ by apply N2Bv_sized_neq_succ.
+ Qed.
+
+ (* Check the eqseq_cons proof *)
+ Lemma cons_eq {n} (x : bool) (a b : Vector.t bool n):
+ (x :: a)%vector =? (x :: b)%vector ->
+ BVeq n n a b.
+ Proof.
+ intros H; apply BVEq_iff_eq in H.
+ rewrite /BVeq.
+ Admitted.
+
+ Lemma Bvector_wrap {W} (v : Bvector W) :
+ W > 0 -> N2Bv_sized W (Bv2N (N2Bv_sized W (Bv2N v + 1)) + 1) =? v ->
+ W = 1.
+ Proof.
+ intros Hpos H.
+ induction v; intros; try discriminate.
+ rewrite ltnS leq_eqVlt in Hpos; move: Hpos => /orP [/eqP Heq | Hpos];
+ [ by subst n | ].
+ apply (IHv) in Hpos as IH; clear IHv.
+ 2: {
+ destruct h; simpl in H; [
+ rewrite N.succ_double_succ N2Bv_sized_double Bv2N_cons N.double_succ_double
+ N2Bv_sized_succ_double N2Bv_sized_Bv2N in H |
+ rewrite N.double_succ_double N2Bv_sized_succ_double Bv2N_cons N.succ_double_succ
+ N2Bv_sized_double N2Bv_sized_Bv2N in H ];
+ apply cons_eq in H;
+ specialize (@N2Bv_sized_eq_p1_false n v) as HH; apply HH in Hpos;
+ by rewrite Hpos in H.
+ }
+ revert H; generalize v; clear v; rewrite IH; intros.
+ simpl in H; destruct h; rewrite (Vector.eta v) in H;
+ specialize (@tl_0 bool v) as H0; rewrite H0 in H;
+ destruct (VectorDef.hd v); simpl in H; discriminate H.
+ Qed.
+
+ Lemma N2Bv_sized_neq_iff: forall (n : nat) (x y : N),
+ N.size_nat x <= n ->
+ N.size_nat y <= n ->
+ x <> y <-> (N2Bv_sized n x <> N2Bv_sized n y).
+ Proof.
+ intros.
+ specialize N2Bv_sized_eq_iff with (n := n) (x := x) (y := y) as HH.
+ rewrite -HH; (try done || by apply /leP).
+ Qed.
+
+ Lemma N2Bv_sized_neq_if : forall (n : nat) (x y : N),
+ (N2Bv_sized n x <> N2Bv_sized n y) -> x <> y.
+ Proof.
+ intros; destruct x,y; congruence.
+ Qed.
+
+ Lemma N2Bv_sized_plusone_diff n (x : Bvector n) :
+ n > 0 -> N2Bv_sized n (Bv2N x + 1) <> x.
+ Proof.
+ intros Hpos.
+ specialize N2Bv_sized_Bv2N with (v := x) as H; rewrite -{2}H.
+ rewrite N.add_1_r.
+ by apply N2Bv_sized_neq_succ.
+ Qed.
+
+ Lemma Cells_data_match {T W N I} (S : circuit_state (mem_cells T W N I)) (we : bool) wa wd wev :
+ (forall n, (wa =? n)%nat = false ->
+ indexConst wev n = CavaClass.constant false) ->
+ indexConst wev wa = CavaClass.constant we ->
+ Cells_read we wa wd S = snd (step (mem_cells T W N I) S (wd,wev)).
+ Proof.
+ intros Hwde Hwe.
+ induction N; [reflexivity | ].
+ unfold mem_cells; fold mem_cells; unfold mem_cell.
+ repeat step_destruct.
+ rewrite (surjective_pairing (step (mem_cells _ _ _ _) SC3 _)) //=.
+ rewrite (surjective_pairing SC2) (surjective_pairing (fst SC2)) IHN.
+ destruct (wa =? N)%nat eqn:Hwa, we.
+ all: try (
+ move : Hwa => /Nat.eqb_eq Hwa; subst N; rewrite Nat.sub_0_r Hwe;
+ simpl; cbv [eq_rect Util.computational_eq];
+ destruct (Nat.eq_dec (S wa) (S wa)); [ | reflexivity];
+ dependent destruction e; reflexivity
+ ).
+ all: rewrite Nat.sub_0_r (Hwde N Hwa); simpl;
+ cbv [eq_rect Util.computational_eq]; destruct (Nat.eq_dec N.+1 N.+1); [ | reflexivity];
+ dependent destruction e; reflexivity.
+ Qed.
+
+End WithCava.
\ No newline at end of file
diff --git a/framework/CavaDRAM/_CoqProject b/framework/CavaDRAM/_CoqProject
index c8848a9..8cb47d1 100644
--- a/framework/CavaDRAM/_CoqProject
+++ b/framework/CavaDRAM/_CoqProject
@@ -1,16 +1,19 @@
INSTALLDEFAULTROOT = CavaDRAM
-R . CavaDRAM
--R /home/felipe/PHD/repository/cleanup/sdram/framework/DRAM DRAM
--R /home/felipe/PHD/tools/cava/silveroak/cava/Cava Cava
--R /home/felipe/PHD/tools/cava/silveroak/third_party/coq-ext-lib/theories ExtLib
--R /home/felipe/PHD/tools/cava/silveroak/third_party/bedrock2/deps/coqutil/src/coqutil coqutil
+-R /home/felipe/PHD/repository/cleanup/sdram/framework/CoqDRAM CoqDRAM
+-R /home/felipe/PHD/tools/cava/silveroakrecompiled/cava/Cava Cava
+-R /home/felipe/PHD/tools/cava/silveroakrecompiled/third_party/coq-ext-lib/theories ExtLib
+-R /home/felipe/PHD/tools/cava/silveroakrecompiled/third_party/bedrock2/deps/coqutil/src/coqutil coqutil
+UtilSM.v
+Util.v
+Step.v
+Memory.v
CavaSystem.v
CavaSubtractor.v
CavaMemory.v
CavaReqQueue.v
+CavaReqQueueProperties.v
CavaCommonInstances.v
-CavaSM.v
CavaFIFOREF.v
-CavaTDMREF.v
CavaSMExtraction.v
\ No newline at end of file
diff --git a/framework/CavaDRAM/backup.v b/framework/CavaDRAM/backup.v
new file mode 100644
index 0000000..afe832f
--- /dev/null
+++ b/framework/CavaDRAM/backup.v
@@ -0,0 +1,1256 @@
+Set Printing Projections.
+Set Warnings "-notation-overridden,-parsing".
+
+From CavaDRAM Require Import CavaFIFOREF CavaSM CavaReqQueue CavaCommonInstances CavaSubtractor Step CavaSystem Memory Util UtilSM.
+From CoqDRAM Require Import FIFO.
+From Coq Require Import Program BinaryString HexString NArith.
+From Cava Require Import Cava CavaProperties Util.Vector Util.Tactics.
+From mathcomp Require Import fintype ssrZ zify ring.
+
+Section CavaFIFOREFProperties.
+ (* From Cava *)
+ Existing Instance CombinationalSemantics.
+ (* From CavaDRAM*)
+ Context {CAVA_SYS : CavaSystem}.
+ (* From CoqDRAM *)
+ Existing Instance REQESTOR_CFG.
+ Context {SYS_CFG : System_configuration}.
+ Context {FIFO_CFG : FIFO_configuration}.
+ Context {HAF : HW_Arrival_function_t}.
+ Existing Instance ARBITER_CFG.
+ Existing Instance FIFO_implementation.
+
+ Import Memory.Properties BvectorNotations.
+ Open Scope Bvector_scope.
+
+ Lemma leq_Nle (a b : N) :
+ leq (nat_of_bin a) (nat_of_bin b) -> (a <= b)%N.
+ Proof.
+ lia.
+ Qed.
+
+ Lemma ltn_Ntn (a b : N) :
+ leq (S (nat_of_bin a)) (nat_of_bin b) -> (a < b)%N.
+ Proof.
+ lia.
+ Qed.
+
+ Lemma Bv2N_upper_bound {n : nat} (bv : Bvector n) :
+ (N.to_nat (Bv2N bv) < (Nat.pow 2 n)).
+ Proof.
+ induction bv; [ by simpl | ]; destruct h; rewrite Bv2N_cons.
+ { rewrite N.succ_double_spec.
+ set z := Bv2N _; fold z in IHbv.
+ rewrite N2Nat.inj_add N2Nat.inj_mul.
+ vm_compute (N.to_nat 1); vm_compute (N.to_nat 2).
+ assert ((2 * N.to_nat z)%coq_nat = (2 * N.to_nat z)%nat); try done; rewrite H; clear H.
+ assert ((2 * N.to_nat z + 1)%coq_nat = (2 * N.to_nat z + 1)%nat); try done; rewrite H; clear H.
+ apply ltn_mul_add1 in IHbv.
+ rewrite Nat.pow_succ_r; [ | apply /leP; by rewrite leq0n ].
+ assert ((2 * (2 ^ n))%coq_nat = (2 * (2 ^ n))%nat); try done; rewrite H; clear H. }
+ { rewrite N.double_spec N2Nat.inj_mul; set z := Bv2N _; fold z in IHbv; vm_compute (N.to_nat 2).
+ assert ((2 * N.to_nat z)%coq_nat = (2 * N.to_nat z)%nat); try done; rewrite H; clear H.
+ have aux : (0 < 2); [ done | ].
+ have H := (ltn_pmul2l aux); rewrite -H in IHbv.
+ rewrite Nat.pow_succ_r; [ | apply /leP; by rewrite leq0n ]; clear H.
+ assert ((2 * (2 ^ n))%coq_nat = (2 * (2 ^ n))%nat); try done; rewrite H; clear H.
+ }
+ Qed.
+
+ Lemma N2Bv_sized_queuemax_neq0 :
+ N2Bv_sized ADDR_WIDTH 0 <> N2Bv_sized ADDR_WIDTH (N.of_nat QUEUE_MAX_SIZE - 1).
+ Proof.
+ apply N2Bv_sized_neq_iff; unfold ADDR_WIDTH.
+ { rewrite /N.size_nat /Nat.log2 //=. }
+ { rewrite -N.pred_sub -Nat2N.inj_pred.
+ apply /leP; apply N.size_nat_le_nat.
+ rewrite QUEUE_MAX_SIZE_PW2; apply /leP.
+ rewrite ltn_predL; apply /leP.
+ exact QUEUE_MAX_SIZE_GT_0. }
+ { rewrite -N.pred_sub -Nat2N.inj_pred.
+ specialize QUEUE_MAX_SIZE_DIFF_0 as HH.
+ move: HH => /N.eqb_spec HH.
+ by apply /N.eqb_spec.
+ }
+ Qed.
+
+ Definition mem_cells_ :=
+ mem_cells (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem.
+
+ (* Check VectorDef.nth. *)
+ Lemma nth_cells_read {T W I} (ad : Bvector W) c_req
+ (c : circuit_state (mem_cells T W (2 ^ W) I)) :
+ VectorDef.nth (Cells_read true (N.to_nat (Bv2N ad)) c_req c) (Bv2Fin ad) = c_req.
+ Proof.
+ (* Induction had to be on N *)
+ induction W.
+ { simpl in c; destruct_products; simpl.
+ apply Vector.case0 with (v := ad); rewrite //=. }
+ { specialize (Vector.eta ad) as HH; rewrite HH //=.
+ simpl in c.
+ destruct (Vector.hd ad).
+ { specialize (IHW (Vector.tl ad)).
+ rewrite /Bv2Fin //=.
+ set Hc := Nat.add _ _.
+ dependent destruction Hc; admit.
+ }
+ }
+ Admitted.
+
+ Lemma memcell_nch (c: circuit_state mem_cells_) wra rda c_req:
+ wra <> rda ->
+ (Cells_data c)[@(Bv2Fin rda)] = (Cells_read true (N.to_nat (Bv2N wra)) c_req c)[@(Bv2Fin rda)].
+ Proof.
+ intros Hdiff.
+ unfold mem_cells_ in c.
+ set Hc := 2 ^ ADDR_WIDTH; dependent induction Hc.
+ { apply Logic.eq_sym in x; simpl in x.
+ admit. (* can't happen *)
+ }
+ specialize (IHHc HAF0 FIFO_CFG0 CAVA_SYS c wra rda c_req).
+ apply Logic.eq_sym in x.
+ Admitted.
+
+ Lemma to_nat_lt_of_nat (a : N) (n : nat) :
+ N.to_nat a < n -> (a < N.of_nat n)%N.
+ Proof.
+ intros.
+ induction n; [ discriminate | ].
+ rewrite leq_eqVlt in H; move: H => /orP [/eqP H | H].
+ { rewrite -H Nat2N.inj_succ N2Nat.id; by specialize (N.lt_succ_diag_r a). }
+ assert (N.to_nat a < n).
+ { specialize (ltn_add2r 1 (N.to_nat a) n) as S; rewrite !addn1 in S; by rewrite S in H. }
+ apply IHn in H0.
+ apply N.lt_trans with (m := N.of_nat n); [ done | ].
+ rewrite Nat2N.inj_succ; by specialize (N.lt_succ_diag_r (N.of_nat n)).
+ Qed.
+
+ Lemma to_nat_lt_pow a b:
+ N.to_nat a < Nat.pow 2 b -> (a < 2 ^ N.of_nat b)%N.
+ Proof.
+ intros; apply to_nat_lt_of_nat in H.
+ rewrite -Nat2N.inj_pow in H.
+ by simpl (N.of_nat 2) in H.
+ Qed.
+
+ Lemma size_nat_sub_leq {n} (a b : Bvector n):
+ (Bv2N b <= Bv2N a)%N ->
+ N.size_nat (Bv2N a - Bv2N b) <= n.
+ Proof.
+ intros; apply /leP; apply N.size_nat_le.
+ specialize (@Bv2N_upper_bound n a) as Ha.
+ specialize (@Bv2N_upper_bound n b) as Hb.
+ destruct (Bv2N b) eqn:Hb0, (Bv2N a) eqn:Ha0; try discriminate.
+ { simpl in *; by apply to_nat_lt_pow. }
+ { rewrite N.sub_0_r; by apply to_nat_lt_pow in Ha. }
+ { by contradict H. }
+ { apply to_nat_lt_pow in Ha,Hb.
+ apply (N.lt_trans (N.pos p0 - N.pos p) (N.pos p0) (2 ^ N.of_nat n)%N); [ | done].
+ apply N.sub_lt; done.
+ }
+ Qed.
+
+ (* Need a to be bigger than b *)
+ Lemma size_nat_qms_sub (a b: Bvector ADDR_WIDTH) :
+ (Bv2N b < Bv2N a)%N ->
+ N.size_nat (N.of_nat QUEUE_MAX_SIZE - (Bv2N a - Bv2N b)) <= ADDR_WIDTH.
+ Proof.
+ intros Hlt; apply /leP.
+ destruct (Bv2N b) eqn:Hb0, (Bv2N a) eqn:Ha0; try done;
+ apply N.size_nat_le; unfold ADDR_WIDTH; rewrite QUEUE_MAX_SIZE_PW2_N; try rewrite N.sub_0_r.
+ { apply N.sub_lt; [ | done].
+ unfold ADDR_WIDTH in a,b.
+ specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) a) as Ha.
+ rewrite QUEUE_MAX_SIZE_PW2 in Ha.
+ rewrite Ha0 in Ha.
+ apply to_nat_lt_of_nat in Ha.
+ apply N.le_lteq; left; exact Ha.
+ }
+ { apply N.sub_lt; [ | apply N.lt_add_lt_sub_l; by rewrite N.add_0_r ].
+ unfold ADDR_WIDTH in a,b.
+ specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) a) as Ha.
+ rewrite QUEUE_MAX_SIZE_PW2 in Ha.
+ specialize (@Bv2N_upper_bound (Nat.log2 QUEUE_MAX_SIZE) b) as Hb.
+ rewrite QUEUE_MAX_SIZE_PW2 in Hb.
+ apply to_nat_lt_of_nat in Ha,Hb; rewrite Ha0 in Ha; rewrite Hb0 in Hb.
+ apply N.le_sub_le_add_l; rewrite N.add_comm.
+ apply N.lt_trans with (m := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) (n := N.pos p0)
+ (p := N.add (N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) (N.pos p)) in Ha as H;
+ [ apply N.le_lteq; by left | ].
+ apply N.lt_add_pos_r; done.
+ }
+ Qed.
+
+ Lemma size_nat_qms :
+ N.size_nat (N.of_nat QUEUE_MAX_SIZE - 1) <= Nat.log2 QUEUE_MAX_SIZE.
+ Proof.
+ rewrite N.sub_1_r -Nat2N.inj_pred.
+ apply /leP; apply N.size_nat_le_nat.
+ rewrite QUEUE_MAX_SIZE_PW2.
+ apply /ltP; rewrite ltn_predL; apply /ltP.
+ exact QUEUE_MAX_SIZE_GT_0.
+ Qed.
+
+ Lemma N2Bv_sized_eq_p1_false {W} (v : Bvector W):
+ W > 0 -> (N2Bv_sized W (Bv2N v + 1) =? v) = false.
+ Proof.
+ intros; apply BVEq_iff_neq.
+ rewrite N.add_1_r.
+ specialize (N2Bv_sized_Bv2N W v) as H0; rewrite -{2}H0.
+ by apply N2Bv_sized_neq_succ.
+ Qed.
+
+ Definition State_t := circuit_state FIFOSM.
+
+ Definition get_mem (s : State_t) : circuit_state memqueue' :=
+ let '(_,(_,(_,(_,_,_,memqueue_state,_,_,_,_,_),_),_,_)) := s in memqueue_state.
+
+ Definition get_pop (s : State_t) :=
+ let '(_,(_,_,_,pop)) := s in pop.
+
+ Definition get_st (s : State_t) :=
+ let '(_,(_,_,(_,(_,_,st)),_)) := s in st.
+
+ Definition get_cnt (s : State_t) :=
+ let '(_,(_,_,(_,(_,(_,_,cnt),_)),_)) := s in cnt.
+
+ Definition get_cref (s : State_t) :=
+ let '(_,(_,_,(_,(_,(_,(_,_,_,_,_,_,_,cref),_),_)),_)) := s in cref.
+
+ Definition get_cr (s : State_t) :=
+ let '(_,(_,_,(_,(_,(_,(_,(_,(_,cr)),_,_,_,_,_,_),_),_)),_)) := s in cr.
+
+ Definition get_wra (s : State_t) :=
+ let '(_,(_,(_,_,wra),_,_)) := s in wra.
+
+ Definition get_rda (s : State_t) :=
+ let '(_,(_,(_,(_,_,_,_,_,_,_,_,rda),_),_,_)) := s in rda.
+
+ Definition get_reqqueue (s : State_t) : circuit_state RequestQueue' :=
+ let '(_,(cs_requeue,_,_)) := s in cs_requeue.
+
+ Definition get_mem_RequestQueue (c : circuit_state RequestQueue') :=
+ let '(_,(_,(_,_, _,memqueue_state,_,_,_,_,_),_)) := c in memqueue_state.
+
+ Definition get_addr_RequestQueue (c : circuit_state RequestQueue') :=
+ let '(_,(_,(_,_, _,_,_,_,_,_,rda),wra)) := c in (wra,rda).
+
+ Definition get_memcells (s : circuit_state memqueue') :=
+ let '(_,memcells_state,_) := s in memcells_state.
+
+ Definition get_memcells_RequestQueue (c : circuit_state RequestQueue') :=
+ get_memcells (get_mem_RequestQueue c).
+
+ (* --------------------------Bounding the counter ------------------- *)
+ Lemma cnt_bounded (cnt : Bvector COUNTER_WIDTH) :
+ N.to_nat (Bv2N cnt) < WAIT.
+ Proof.
+ specialize @Bv2N_upper_bound with (bv := cnt) as H.
+ by rewrite /COUNTER_WIDTH WAIT_PW_2 in H.
+ Qed.
+
+ Definition Bv2cnt (cnt : Bvector COUNTER_WIDTH) : Counter_t :=
+ Ordinal (cnt_bounded cnt).
+
+ Definition cnt2Bv (cnt : Counter_t) :=
+ N2Bv_sized COUNTER_WIDTH (N.of_nat (nat_of_ord cnt)).
+ (* ------------------------------------------------------------------ *)
+
+ (* --------------------------Bounding cref counter ------------------- *)
+ Lemma cref_bounded (cref : Bvector COUNTER_REF_WIDTH) :
+ N.to_nat (Bv2N cref) < WAIT_REF.
+ Proof.
+ specialize @Bv2N_upper_bound with (bv := cref) as H.
+ by rewrite /COUNTER_REF_WIDTH WAIT_REF_PW2 in H.
+ Qed.
+
+ Definition Bv2cref (cnt : Bvector COUNTER_REF_WIDTH) : Counter_ref_t :=
+ Ordinal (cref_bounded cnt).
+
+ Definition cref2Bv (cref : Counter_ref_t) :=
+ N2Bv_sized COUNTER_REF_WIDTH (N.of_nat (nat_of_ord cref)).
+ (* ------------------------------------------------------------------ *)
+
+ Lemma cref_preadate_false (c : Counter_ref_t) :
+ (cref2Bv c =? CNT_REF_PREA) = false ->
+ (nat_of_ord c == PREA_date - 1) = false.
+ Proof.
+ unfold cref2Bv, CNT_REF_PREA; intros.
+ apply BVEq_iff_neq in H; rewrite bitvec_literal_correct in H.
+ apply N2Bv_sized_neq_if in H.
+ apply of_nat_neq in H.
+ by apply /eqP.
+ Qed.
+
+ Lemma cref_preadate_true (c : Counter_ref_t) :
+ (cref2Bv c =? CNT_REF_PREA) = true ->
+ (nat_of_ord c == PREA_date - 1) = true.
+ Proof.
+ unfold cref2Bv, CNT_REF_PREA; intros.
+ apply BVEq_iff_eq in H; rewrite bitvec_literal_correct in H.
+ apply N2Bv_sized_eq_iff in H.
+ { apply Nat2N.inj in H; rewrite H; by apply /eqP. }
+ { apply N.size_nat_le_nat.
+ destruct c; simpl in *; rewrite /COUNTER_REF_WIDTH; apply /ltP.
+ by rewrite WAIT_REF_PW2. }
+ { apply N.size_nat_le_nat; unfold COUNTER_REF_WIDTH.
+ rewrite WAIT_REF_PW2 subn1; apply /ltP.
+ specialize WAIT_REF_PREA_date as HH.
+ apply ltn_trans with (m := PREA_date.-1) in HH; [ exact HH | ].
+ by rewrite ltn_predL PREA_date_pos.
+ }
+ Qed.
+
+ Definition fullQueue (wa ra : Bvector ADDR_WIDTH) : bool :=
+ let waN := Bv2N wa in
+ let raN := Bv2N ra in
+ let qms := N.sub (N.of_nat QUEUE_MAX_SIZE) 1 in
+ if (raN <= waN)%nat then ((Bv2N wa - Bv2N ra)%N == qms)
+ else (((N.add qms 1) - (raN - waN))%N == qms).
+
+ Hypothesis HaltIfFull : forall t c,
+ let wra := get_wra c in
+ let rda := get_rda c in
+ if (HW_Arrival_at t != []) then ~~ fullQueue wra rda else true.
+
+ Program Definition EqReq (r : Request_t) (r' : Bvector REQUEST_WIDTH) : bool.
+ Admitted.
+
+ Lemma EqReqNil : EqReq nullreq REQUEST_NIL = true.
+ Admitted.
+
+ (* Change FIFO implememtation: set of requests of max size 1,
+ so it could either have a request or a non arriving request,
+ that way, eveyr request in P is a valid request
+ would have to change lots of things here:
+ - HaltIfFull
+ - EqQueue
+ - EqMem
+ *)
+
+ (* Manually force push to be false *)
+
+ (* Definition EqArrival r r' push c : bool :=
+ let wra := get_wra c in
+ let rda := get_rda c in
+ if r == nullreq
+ (* If the arriving request is nullreq, either the fifo is full or there are no arriving requests *)
+ then (r' =? REQUEST_NIL) && (push == false)
+ (* If a request did arrive indeed than the fifo is not full *)
+ else (EqReq r r') && (push == true) && (~~ fullQueue wra rda). *)
+
+ Definition EqCmd (f_cmd : Command_kind_t) (c_cmd : Bvector DRAM_CMD_WIDTH) : bool :=
+ match f_cmd with
+ | ACT => (c_cmd =? ACT_VEC)
+ | PRE => (c_cmd =? PRE_VEC)
+ | PREA => (c_cmd =? PREA_VEC)
+ | CRD => (c_cmd =? RD_VEC)
+ | CWR => (c_cmd =? WR_VEC)
+ | REF => (c_cmd =? REF_VEC)
+ | NOP => (c_cmd =? NOP_VEC)
+ end.
+
+ Fixpoint EqQueue (P : Requests_t) (wra rda : Bvector ADDR_WIDTH) :=
+ match P with
+ | [::] => (wra =? rda)
+ | x :: x0 =>
+ if (x0 == []) then
+ (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? wra)
+ else
+ negb (wra =? rda) && (EqQueue x0 wra (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1)))
+ end.
+
+
+ if (x == nullreq) then (EqQueue x0 wra rda)
+ else (if (x0 == []) then
+ (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? wra) (* only one non-null addres in the queue *)
+ else
+ negb (wra =? rda) && (EqQueue x0 wra (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1)))
+ )
+ end.
+
+ Fixpoint EqMem_ {W} (P : Requests_t) (rda : Bvector W)
+ (memcells_vec : Vector.t (Bvector REQUEST_WIDTH) (Nat.pow 2 W)) : bool :=
+ match P with
+ | [::] => true
+ | x :: x0 => let nrda := N2Bv_sized W (Bv2N rda + 1) in
+ if (x == nullreq) then
+ (EqMem_ x0 rda memcells_vec)
+ else
+ (EqReq x memcells_vec[@(Bv2Fin rda)]) && (EqMem_ x0 nrda memcells_vec)
+ end.
+
+ Lemma EqMem_rcons r1 (rda wra : Bvector ADDR_WIDTH) c R (c_req : combType (Vec Bit REQUEST_WIDTH)) :
+ EqQueue r1 wra rda -> r1 != [::] ->
+ EqMem_ r1 rda (@Cells_data (Vec Bit REQUEST_WIDTH) ADDR_WIDTH (Nat.pow 2 ADDR_WIDTH) InitMem c) ->
+ EqReq R c_req ->
+ EqMem_ (r1 ++ [R])%SEQ rda (Cells_read true (N.to_nat (Bv2N wra)) c_req c).
+ Proof.
+ intros HQ Hnot_nil Mem EqR; fold mem_cells_ in c; rewrite cats1.
+ revert Mem HQ Hnot_nil; generalize wra rda; induction r1; try discriminate; intros.
+ simpl in Mem,HQ; simpl; destruct (a == _) eqn:Hanull.
+ { destruct r1 eqn:Hr1; simpl in Mem,HQ.
+ { clear IHr1 Mem.
+ simpl; destruct (R == _); [trivial | rewrite andb_true_r].
+ apply BVEq_iff_eq in HQ; rewrite -HQ.
+ by rewrite (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem wra0 c_req c).
+ }
+ { apply IHr1 with (wra := wra0) (rda := rda0) in HQ; done. }
+ }
+ move: Mem => /andP [EqR_ Mem]; apply /andP; split.
+ { destruct r1 eqn:hr1; simpl in HQ,Mem; simpl.
+ { destruct (wra0 =? rda0) eqn:Heq.
+ { apply BVEq_iff_eq in Heq; rewrite Heq in HQ.
+ specialize ADDR_WIDTH_pos as H0; move: H0 => /ltP H0.
+ apply N2Bv_sized_eq_p1_false with (v := rda0) in H0; by rewrite H0 in HQ.
+ }
+ { apply BVEq_iff_neq in Heq.
+ rewrite -memcell_nch; done. }}
+ { move: HQ => /andP [neq HQ].
+ destruct (r == _),l.
+ all: move: neq => /negPf neq; apply BVEq_iff_neq in neq; rewrite -memcell_nch; done. }}
+ { destruct r1 eqn:hr1; simpl in HQ,Mem; simpl.
+ { destruct (R == _); [trivial | rewrite andb_true_r].
+ apply BVEq_iff_eq in HQ; rewrite HQ.
+ by rewrite (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem wra0 c_req c).
+ }
+ { move: HQ => /andP [neq HQ].
+ specialize (IHr1 wra0 (N2Bv_sized ADDR_WIDTH (Bv2N rda0 + 1))); apply IHr1; try done. }
+ }
+ Qed.
+
+ (* Just use the circuit directly <-> circuit does the work directly *)
+ Definition EqMem (P : Requests_t) rda (mem : circuit_state RequestQueue') :=
+ let memcells_vec := Cells_data (get_memcells_RequestQueue mem) in
+ EqMem_ P rda memcells_vec.
+
+ Definition State_Eq (fram_state : FIFO_state_t) (cava_state : State_t) : bool :=
+ let s := get_st cava_state in
+ let c' := get_cnt cava_state in
+ let cref' := get_cref cava_state in
+ let r' := get_cr cava_state in
+ let RQ := get_reqqueue cava_state in
+ let wra := fst (get_addr_RequestQueue RQ) in
+ let rda := snd (get_addr_RequestQueue RQ) in
+ let pop := get_pop cava_state in
+ match fram_state with
+ | IDLE c cref P =>
+ (s =? STATE_IDLE_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
+ (EqQueue P wra rda) && (pop == false)
+ | RUNNING c cref P r =>
+ (s =? STATE_RUN_VEC) && (c' =? cnt2Bv c) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
+ (EqQueue P wra rda) && (EqReq r r') && (pop == (c == OCycle0))
+ | REFRESHING cref P =>
+ (s =? STATE_REF_VEC) && (cref' =? cref2Bv cref) && (EqMem P rda RQ) &&
+ (EqQueue P wra rda) && (pop == false)
+ end.
+
+ (* -------------- Proofs about CmdGen ------------------------------- *)
+ Lemma CmdGen_equiv_idle_to_idle (c : circuit_state CmdGen) cnt cref:
+ (cref =? CNT_REF_PREA) = false ->
+ exists c', step CmdGen c (STATE_IDLE_VEC,true,cnt,cref,REQUEST_NIL) =
+ (c',NOP_VEC).
+ Proof.
+ intros H; simpl in c; destruct_products.
+ eapply ex_intro.
+ cbv [CmdGen]; cbn [step fst snd].
+ simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; simpl.
+ cbv [CrefPREA_eq].
+ apply BVEq_iff_neq in H.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply HH in H; rewrite H VectorSpec.map_id; reflexivity.
+ Qed.
+
+ Lemma CrefPREA_lt_CNT_REF_PREA:
+ CrefPREA_lt CNT_REF_PREA = false.
+ Proof.
+ cbv [CrefPREA_lt]; simpl_ident.
+ unfold greaterThanOrEqual; simpl_ident; unfold greaterThanOrEqualBool.
+ apply /negbF.
+ rewrite {1}/CNT_REF_PREA; rewrite !bitvec_literal_correct.
+ apply /N.leb_spec0; rewrite /CNT_REF_PREA /CNT_REF_WAIT !bitvec_literal_correct.
+ rewrite !Bv2N_N2Bv_sized. { apply N.le_add_r. }
+ all: rewrite /COUNTER_REF_WIDTH WAIT_REF_PW_N.
+ all: try apply N_lt_inj.
+ all: specialize WAIT_REF_PREA_date_WAIT as H; lia.
+ Qed.
+
+ Lemma CmdGen_equiv_idle_to_ref (c : circuit_state CmdGen) cnt cref e:
+ (cref =? CNT_REF_PREA) = true ->
+ exists c', step CmdGen c (STATE_IDLE_VEC,e,cnt,cref,REQUEST_NIL) = (c',PREA_VEC).
+ Proof.
+ intros; simpl in c; destruct_products; eapply ex_intro.
+ cbv [CmdGen]; cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; simpl; rewrite VectorSpec.map_id.
+ apply BVEq_iff_eq in H; subst cref; rewrite CrefPREA_lt_CNT_REF_PREA !VectorSpec.map_id.
+ rewrite andb_false_r; rewrite /CrefPREA_eq.
+ specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ assert (CNT_REF_PREA = CNT_REF_PREA); [done | ]; apply HH in H; by rewrite H.
+ Qed.
+ (* ------------------------------------------------------------------ *)
+
+ (* -------------- Proofs about NextCR ------------------------------- *)
+ Lemma NextCR_equiv (c : circuit_state NextCR) cnt cref tr:
+ exists c', step NextCR c (STATE_IDLE_VEC,true,cnt,cref,tr) =
+ (c',REQUEST_NIL).
+ Proof.
+ simpl in c; destruct_products.
+ eapply ex_intro.
+ cbv [NextCR LoopInit]; cbn [step fst snd].
+ simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ fast_simpl_bool; by simpl.
+ Qed.
+
+ Lemma NextCR_equiv_IDLE_NE_PREA c cnt cref tr:
+ (cref =? CNT_REF_PREA) = true ->
+ exists c', step NextCR c (STATE_IDLE_VEC,false,cnt,cref,tr) =
+ (c',REQUEST_NIL).
+ Proof.
+ intros; simpl in c; destruct_products; eapply ex_intro.
+ cbv [NextCR LoopInit]; cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ rewrite negb_false andb_true_l; rewrite /Srun //= VectorSpec.map_id.
+ apply BVEq_iff_eq in H; subst cref.
+ by rewrite CrefPREA_lt_CNT_REF_PREA.
+ Qed.
+ (* ------------------------------------------------------------------ *)
+
+ Create HintDb update.
+ Lemma Sidle_true :
+ Sidle STATE_IDLE_VEC = true.
+ Proof.
+ apply CavaPreludeProperties.eqb_refl.
+ Qed.
+ Hint Rewrite @Sidle_true : update.
+
+ Lemma Sref_idle_false :
+ Sref STATE_IDLE_VEC = false.
+ Proof.
+ by apply CavaPreludeProperties.eqb_neq.
+ Qed.
+ Hint Rewrite @Sref_idle_false : update.
+
+ Lemma cnt_equiv (cnt : Bvector COUNTER_WIDTH) :
+ (if CeqWAIT cnt then Bvect_false COUNTER_WIDTH
+ else N2Bv_sized COUNTER_WIDTH (Bv2N cnt + 1)) = cnt2Bv (Next_cycle (Bv2cnt cnt)).
+ Proof.
+ cbv [CeqWAIT].
+ destruct (CavaPrelude.eqb (cnt, CNT_WAIT)) eqn:Heq; rewrite Heq.
+ { specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit COUNTER_WIDTH) (x := cnt) as H.
+ apply H in Heq; clear H.
+ unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { rewrite /CNT_WAIT bitvec_literal_correct in Heq.
+ rewrite Heq /Bv2cnt //= Bv2N_N2Bv_sized in x.
+ 2: {
+ rewrite /COUNTER_WIDTH; have id := (N2Nat.id 2).
+ rewrite -id Nat2N.inj_pow //= /Pos.to_nat //= WAIT_PW_2.
+ apply: N_lt_inj; apply /ltP; by rewrite subn1 ltn_predL WAIT_pos.
+ }
+ rewrite Nat2N.id subn1 prednK in x; [ | exact WAIT_pos ]; by rewrite ltnn in x.
+ }
+ { unfold cnt2Bv,OCycle0; by simpl. }}
+ { unfold Next_cycle; set (Hc := (Bv2cnt cnt).+1 < WAIT); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { unfold cnt2Bv; apply f_equal; simpl.
+ rewrite N.add_1_r -(N.succ_pos_pred (Pos.of_succ_nat (N.to_nat (Bv2N cnt)))).
+ apply f_equal; by rewrite predN_of_succ_nat. }
+ { apply ltn_gt in e,x.
+ rewrite leq_eqVlt in e; move: e => /orP [/eqP e | e].
+ { have HH := (@eqb_iff_neq (Vec Bit (@COUNTER_WIDTH SYS_CFG FIFO_CFG))).
+ apply HH in Heq. rewrite /CNT_WAIT bitvec_literal_correct in Heq;
+ rewrite -(N2Bv_sized_Bv2N (@COUNTER_WIDTH SYS_CFG FIFO_CFG) cnt) in Heq.
+ apply N2Bv_sized_neq_if in Heq.
+ by rewrite e subn1 -pred_Sn N2Nat.id in Heq. }
+ { specialize ltn_ord with (n := @WAIT SYS_CFG FIFO_CFG) (i := Ordinal (cnt_bounded cnt)) as H.
+ rewrite //= in H.
+ contradict H; apply /negP; by rewrite -ltnNge.
+ }
+ }
+ }
+ Qed.
+
+ Lemma cref_equiv (cref : Bvector COUNTER_REF_WIDTH) :
+ (if CrefPREA_eq cref then Bvect_false COUNTER_REF_WIDTH
+ else N2Bv_sized COUNTER_REF_WIDTH (Bv2N cref + 1)) = cref2Bv (Next_cycle_ref (Bv2cref cref)).
+ Admitted.
+ (* Proof.
+ cbv [CrefPREA_eq].
+ destruct (CavaPrelude.eqb (cref, CNT_REF_PREA)) eqn:Hcref; rewrite Hcref.
+ { specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit COUNTER_REF_WIDTH) (x := cref) as H.
+ apply H in Hcref; clear H.
+ unfold Next_cycle_ref; set (Hc := (Bv2cref cref).+1 < WAIT_REF); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { rewrite /CNT_REF_PREA bitvec_literal_correct in Hcref.
+ rewrite Hcref /Bv2cref //= Bv2N_N2Bv_sized in x.
+ 2: {
+ rewrite /COUNTER_REF_WIDTH; have id := (N2Nat.id 2).
+ rewrite WAIT_REF_PW_N.
+ (* rewrite -id Nat2N.inj_pow //=. *)
+ (* rewrite /Pos.to_nat //=. WAIT_REF_PW_N. *)
+ apply: N_lt_inj; apply /ltP.
+ rewrite subn1.
+ specialize WAIT_REF_PREA_date as H.
+ apply ltn_trans with (n := PREA_date); [ | exact WAIT_REF_PREA_date].
+ by rewrite ltn_predL PREA_date_pos.
+ }
+ rewrite Nat2N.id subn1 prednK in x; [ | exact PREA_date_pos ]; by rewrite ltnn in x.
+ }
+ { unfold cref2Bv,OCycle0; by simpl. }}
+ { unfold Next_cycle_ref; set (Hc := (Bv2cref cref).+1 < PREA_date); dependent destruction Hc;
+ apply Logic.eq_sym in x; move : Logic.eq_refl; rewrite {2 3} x; simpl; intro.
+ { unfold cref2Bv; apply f_equal; simpl.
+ rewrite N.add_1_r -(N.succ_pos_pred (Pos.of_succ_nat (N.to_nat (Bv2N cref)))).
+ f_equal; by rewrite predN_of_succ_nat. }
+ { apply ltn_gt in e,x.
+ rewrite leq_eqVlt in e; move: e => /orP [/eqP e | e].
+ { have HH := (@eqb_iff_neq (Vec Bit (@COUNTER_REF_WIDTH SYS_CFG))).
+ apply HH in Hcref. rewrite /CNT_REF_PREA bitvec_literal_correct in Hcref;
+ rewrite -(N2Bv_sized_Bv2N (@COUNTER_REF_WIDTH SYS_CFG) cref) in Hcref.
+ apply N2Bv_sized_neq_if in Hcref.
+ by rewrite e subn1 -pred_Sn N2Nat.id in Hcref. }
+ { specialize ltn_ord with (n := PREA_date) (i := Ordinal (cref_bounded cref)) as H.
+ rewrite //= in H.
+ contradict H; apply /negP; by rewrite -ltnNge.
+ }
+ }
+ }
+ Qed. *)
+
+ (* -------------- Proofs about Update ------------------------------- *)
+ (* Don't try to match it with the next_cycle_ref, but rather something else *)
+ Lemma Update_equiv_idle_idle (c : circuit_state Update) cnt cref :
+ (cref =? CNT_REF_PREA) = false ->
+ let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
+ let ncref := N2Bv_sized COUNTER_REF_WIDTH (Bv2N cref + 1) in
+ snd (step Update c (STATE_IDLE_VEC,true,cnt,cref)) =
+ (STATE_IDLE_VEC,false,nc,ncref).
+ Proof.
+ intros Hcref Hcnt; simpl in c.
+ cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
+ cbv [Update Update_s Update_e Update_c Update_cref].
+ cbn [step fst snd]; simpl_ident.
+ autorewrite with update; vm_compute (false && _).
+ apply BVEq_iff_neq in Hcref.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply pair_equal_spec; split.
+ 2: {
+ rewrite orb_false_l andb_true_l.
+ rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
+ }
+ cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
+ vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id andb_false_r.
+ apply pair_equal_spec; split; [
+ apply pair_equal_spec; split; [ by unfold STATE_IDLE_VEC | reflexivity] | ].
+ vm_compute (orb false false); rewrite orb_false_r; by specialize (cnt_equiv cnt).
+ Qed.
+
+ Lemma Update_equiv_idle_ref (c : circuit_state Update) cnt cref e:
+ (cref =? CNT_REF_PREA) = true ->
+ let nc := cnt2Bv (Next_cycle (Bv2cnt cnt)) in
+ let ncref := CNT_REF_NIL in
+ exists c', (step Update c (STATE_IDLE_VEC,e,cnt,cref)) =
+ (c',(STATE_REF_VEC,false,nc,ncref)).
+ Proof.
+ intros Hcref Hcnt; simpl in c; eapply ex_intro.
+ cbv [cnt2Bv]; unfold Hcnt; clear Hcnt.
+ cbv [Update Update_s Update_e Update_c Update_cref].
+ cbn [step fst snd]; simpl_ident.
+ apply pair_equal_spec; split; [reflexivity | ].
+ autorewrite with update; vm_compute (false && _).
+ apply BVEq_iff_eq in Hcref.
+ specialize @CavaPreludeProperties.eqb_eq with (t := Vec Bit (@COUNTER_REF_WIDTH SYS_CFG FIFO_CFG)) as HH.
+ apply pair_equal_spec; split.
+ 2: {
+ rewrite orb_false_l andb_true_l.
+ rewrite /CrefPREA_eq; apply HH in Hcref; by rewrite Hcref.
+ }
+ cbv [CrefPREA_eq]; apply HH in Hcref as Hcref'; rewrite Hcref';
+ vm_compute (false || true && false); simpl; rewrite !VectorSpec.map_id.
+ apply pair_equal_spec; split.
+ 2: {
+ vm_compute (orb false false); rewrite orb_false_r.
+ destruct e; [rewrite negb_true | rewrite negb_false].
+ { rewrite andb_false_r orb_false_r; by specialize (cnt_equiv cnt). }
+ { rewrite andb_true_r.
+ destruct (CrefPREA_lt cref) eqn:Hbug.
+ { by rewrite Hcref CrefPREA_lt_CNT_REF_PREA in Hbug. }
+ { rewrite orb_false_r; by specialize (cnt_equiv cnt). }
+ }
+ }
+ apply pair_equal_spec; split; [ done | ].
+ rewrite Hcref CrefPREA_lt_CNT_REF_PREA; by rewrite andb_false_l.
+ Qed.
+ (* ------------------------------------------------------------------ *)
+
+ (* -------------- Proofs about FullEmptyLogic ------------------------------- *)
+ Lemma FEL_emp_equiv (c : circuit_state FullEmptyLogic) wra rda :
+ wra = rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,true)).
+ Proof.
+ intros H; eapply ex_intro.
+ cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
+ cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply pair_equal_spec; split; [ | by rewrite H CavaPreludeProperties.eqb_refl ].
+ rewrite inv_correct; cbv [bind].
+ rewrite fullAdder_cin; cbv [unpackV]; simpl_ret.
+ destruct (one) eqn:Hone; [ | discriminate].
+ destruct ((Bv2N rda) <= (Bv2N wra)) eqn:Hleq;
+ [ | by rewrite H leqnn in Hleq ].
+ assert (N.sub (Bv2N wra) (Bv2N rda) = 0%N); [ by rewrite H N.sub_diag | ].
+ rewrite H0 !bitvec_literal_correct.
+ set (N := N.sub _ _).
+ specialize N2Bv_sized_queuemax_neq0 as H2.
+ specialize @CavaPreludeProperties.eqb_neq with (t := Vec Bit (@ADDR_WIDTH CAVA_SYS))
+ (x := N2Bv_sized ADDR_WIDTH 0) (y := N2Bv_sized ADDR_WIDTH N) as HH.
+ by apply HH in H2.
+ Qed.
+
+ Lemma FEL_nemp_wrap1_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
+ let wrap1 := N2Bv_sized ADDR_WIDTH (Bv2N wra + 1) in
+ wra = rda -> exists c' f', step FullEmptyLogic c (wrap1,rda) = (c',(f',false)).
+ Proof.
+ intros; repeat eapply ex_intro; unfold wrap1.
+ cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
+ cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply CavaPreludeProperties.eqb_neq; rewrite H.
+ apply N2Bv_sized_plusone_diff; unfold ADDR_WIDTH.
+ specialize QUEUE_MAX_SIZE_GT_1 as HQ; apply Nat.log2_pos in HQ.
+ by move: HQ => /ltP HQ.
+ Qed.
+
+ Lemma FEL_nemp_NF_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
+ ~~ (fullQueue wra rda) ->
+ wra <> rda -> exists c', step FullEmptyLogic c (wra,rda) = (c',(false,false)).
+ Proof.
+ intros NF H; eapply ex_intro.
+ rewrite /fullQueue in NF.
+ cbv [FullEmptyLogic FullLogic EmptyLogic Subtractor subtractor dropr EqFULL FullVEC unpackV];
+ cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ apply pair_equal_spec; split; [ | by apply CavaPreludeProperties.eqb_neq ].
+ rewrite bitvec_literal_correct.
+ rewrite fullAdder_cin; destruct (one) eqn:Hbug; try discriminate; clear Hbug.
+ cbv [unpackV].
+ destruct (_ <= _) eqn:Hleq; apply CavaPreludeProperties.eqb_neq.
+ { set (xx := (Bv2N wra - Bv2N rda)%N); fold xx in NF.
+ set (yy := ((N.of_nat QUEUE_MAX_SIZE - 1)%N)); fold yy in NF.
+ assert (N.size_nat xx <= ADDR_WIDTH);
+ [ apply size_nat_sub_leq; by apply leq_Nle in Hleq | ].
+ assert (N.size_nat yy <= ADDR_WIDTH);
+ [ unfold ADDR_WIDTH, yy; by apply size_nat_qms | ].
+ apply N2Bv_sized_neq_iff; try done; by apply /eqP.
+ }
+ { rewrite {3}/ADDR_WIDTH QUEUE_MAX_SIZE_PW2; apply N2Bv_sized_neq_iff.
+ { assert (Bv2N rda > Bv2N wra); [ lia | ].
+ apply size_nat_qms_sub; by apply ltn_Ntn in H0.
+ }
+ { unfold ADDR_WIDTH; by apply size_nat_qms. }
+ specialize add_1_sub1 with (x := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) as HH.
+ rewrite HH in NF; [ | exact QUEUE_MAX_SIZE_GT_0_N].
+ apply /eqP; exact NF.
+ }
+ Qed.
+
+ Lemma FEL_NF_equiv (c : circuit_state FullEmptyLogic) (wra rda : Bvector ADDR_WIDTH) :
+ ~~ (fullQueue wra rda) ->
+ exists c' e', step FullEmptyLogic c (wra,rda) = (c',(false,e')).
+ Proof.
+ intros NF; unfold fullQueue in NF; repeat eapply ex_intro.
+ cbv [FullEmptyLogic]; cbn [step]; simpl_ret; cbn [fst snd].
+ apply pair_equal_spec; split; [reflexivity | ].
+ apply pair_equal_spec; split; [ | reflexivity ].
+ cbv [dropr subtractor EqFULL FullVEC unpackV]; simpl_ident.
+ destruct ((Bv2N rda) <= (Bv2N wra)) eqn:Hleq;
+ destruct (one) eqn:Hone; try discriminate;
+ rewrite fullAdder_cin Hleq;
+ apply CavaPreludeProperties.eqb_neq; move: NF => /eqP NF.
+ { set (xx := (Bv2N wra - Bv2N rda)%N); fold xx in NF.
+ set (yy := ((N.of_nat QUEUE_MAX_SIZE - 1)%N)); fold yy in NF.
+ assert (N.size_nat xx <= ADDR_WIDTH);
+ [ apply size_nat_sub_leq; by apply leq_Nle in Hleq | ].
+ assert (N.size_nat yy <= ADDR_WIDTH);
+ [ unfold ADDR_WIDTH, yy; by apply size_nat_qms | ].
+ apply N2Bv_sized_neq_iff; try done; by apply /eqP.
+ }
+ { rewrite {3}/ADDR_WIDTH QUEUE_MAX_SIZE_PW2; apply N2Bv_sized_neq_iff.
+ { assert (Bv2N rda > Bv2N wra) as H; [ lia | ].
+ apply size_nat_qms_sub; by apply ltn_Ntn in H.
+ }
+ { unfold ADDR_WIDTH; by apply size_nat_qms. }
+ specialize add_1_sub1 with (x := N.of_nat (@QUEUE_MAX_SIZE CAVA_SYS)) as HH.
+ by rewrite HH in NF; [ | exact QUEUE_MAX_SIZE_GT_0_N].
+ }
+ Qed.
+ (* ------------------------------------------------------------------ *)
+
+ Lemma incrn_pointr_true_equiv (c : circuit_state incr_pointr) ad :
+ step incr_pointr c (ad,true) =
+ (tt,N2Bv_sized ADDR_WIDTH (Bv2N ad + 1)).
+ Proof.
+ cbv [incr_pointr step] ; by simpl_ident.
+ Qed.
+
+ Lemma incrn_pointr_false_equiv (c : circuit_state incr_pointr) ad :
+ step incr_pointr c (ad,false) = (tt,ad).
+ Proof.
+ cbv [incr_pointr step] ; by simpl_ident.
+ Qed.
+
+ Create HintDb get_state.
+ Hint Unfold get_memcells : get_state.
+ Hint Unfold get_addr_RequestQueue : get_state.
+ Hint Unfold get_mem_RequestQueue : get_state.
+ Hint Unfold get_memcells_RequestQueue : get_state.
+ Hint Unfold get_mem : get_state.
+
+ (* the not full could come either be satisfies from the not full hypothesis
+ or from wra = rda *)
+ Lemma RQ_fst_pushT_popF_NF (c : circuit_state RequestQueue') c_req :
+ let '(wra,rda) := get_addr_RequestQueue c in
+ let S := get_memcells_RequestQueue c in
+ let wra_idx := N.to_nat (Bv2N wra) in
+ let memcells_spec := Cells_read true wra_idx c_req S in
+ ~~ (fullQueue wra rda) -> exists c',
+ ((Cells_data (get_memcells_RequestQueue c') = memcells_spec) /\
+ (fst (get_addr_RequestQueue c')) = (N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) /\
+ (snd (get_addr_RequestQueue c')) = rda) /\
+ fst (step RequestQueue' c (true,c_req,false)) = c'.
+ Admitted.
+ (* simpl in c; destruct_products.
+ unfold get_addr_RequestQueue; intros Hfull; eapply ex_intro; split; [ | reflexivity].
+ set (p := step RequestQueue' _ _).
+ cbv [RequestQueue' LoopInit fork2] in p.
+ cbn [step] in p; cbn [fst snd] in p; simpl_ret_H p;z cbv [fst snd] in p.
+ specialize FEL_NF_equiv with (c := (u17, (u19, u20, u18), u16))
+ (rda := t0) (wra := t) as H; apply H in Hfull; clear H.
+ destruct Hfull as [cs_FEL' [empty_o Hfull]].
+ unfold p; clear p; rewrite Hfull.
+ cbn [fst snd bind inv and2 or2]; fast_simpl_bool.
+ rewrite (surjective_pairing (step memqueue' _ _)).
+ rewrite incrn_pointr_true_equiv incrn_pointr_false_equiv.
+ rewrite (surjective_pairing (step FullEmptyLogic _ _)).
+ set (fel := step FullEmptyLogic _ _).
+ split.
+ { simpl in fel; unfold fel; cbv [snd fst].
+ cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ cbv [memqueue' Memory' mem_write mem_read]; cbn [step fst snd]; simpl_ident; cbv [fst snd].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ cbv [fst snd].
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end.
+ fold mem_cells_.
+ specialize @Cells_matchX with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
+ (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
+ (S0 := c) (we := true) (wd := c_req) (wa := (N.to_nat (Bv2N t))) as HH.
+ rewrite -HH; [reflexivity | | ].
+ all: admit.
+ }
+ split; by simpl.
+ Admitted. *)
+
+ (* Ignoring the full signal because it just goes to the output *)
+ Lemma RQ_snd_pushT_empty (c : circuit_state RequestQueue') c_req pop :
+ let '(wra,rda) := get_addr_RequestQueue c in
+ let S := get_memcells_RequestQueue c in
+ let rda_idx := N.to_nat (Bv2N rda) in
+ let wra_idx := N.to_nat (Bv2N wra) in
+ let memcells' := Cells_read true wra_idx c_req S in
+ let mem_val := nth_default (req_null) rda_idx memcells' in
+ wra = rda -> exists f',
+ snd (step RequestQueue' c (true,c_req,pop)) = (f',mem_val,true).
+ Admitted.
+ (* simpl in c; destruct_products; rename t0 into rda, t into wra.
+ autounfold with get_state; intros.
+ cbv [RequestQueue' LoopInit fork2]; simpl_ret; cbn [step fst snd].
+ eapply FEL_emp_equiv with (c := (u17,(u19,u20,u18), u16)) in H as HH.
+ destruct HH as [cs_FEL HH]; rewrite HH.
+ cbn [fst snd bind inv and2 or2].
+ rewrite (surjective_pairing (step memqueue' (u12,c,u11) _)).
+ cbv [fst snd]; fast_simpl_bool.
+ rewrite incrn_pointr_true_equiv if_same incrn_pointr_false_equiv; clear HH.
+ eapply FEL_nemp_wrap1_equiv with (c := (u4, (u6, u7, u5), u3)) in H as HH.
+ destruct HH as [cs_FELL [full_o HH]]; rewrite HH; clear HH.
+ eapply ex_intro.
+ apply pair_equal_spec; split; [ | reflexivity ].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ cbv [memqueue' Memory' mem_write mem_read].
+ cbn [step fst snd]; simpl_ret.
+ rewrite (surjective_pairing (step (mem_cells _ _ _ _) c _)).
+ specialize @Cells_data_match with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
+ (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
+ (S0 := c) (we := true) (wa := (N.to_nat (Bv2N wra))) (wd := c_req) as HH.
+ rewrite -HH.
+ { cbv [indexAt indexConst defaultCombValue].
+ cbv [unpackV bind]; simpl_ret.
+ rewrite nth_0; simpl; unfold req_null.
+ reflexivity.
+ }
+ all: admit.
+ Admitted. *)
+
+ Lemma RQ_snd_pushT_popF_NF_nempty (c : circuit_state RequestQueue') c_req:
+ let '(wra,rda) := get_addr_RequestQueue c in
+ let S := get_memcells_RequestQueue c in
+ let rda_idx := N.to_nat (Bv2N rda) in
+ let wra_idx := N.to_nat (Bv2N wra) in
+ let memcells' := Cells_read true wra_idx c_req S in
+ let mem_val := nth_default (req_null) rda_idx memcells' in
+ ~~ (fullQueue wra rda) -> wra <> rda -> exists full_o,
+ snd (step RequestQueue' c (true,c_req,false)) = (full_o,mem_val,false).
+ Admitted.
+ (* simpl in c; destruct_products; rename t0 into rda, t into wra.
+ autounfold with get_state; intros.
+ cbv [RequestQueue' LoopInit fork2]; simpl_ret; cbn [step fst snd].
+ apply FEL_nemp_NF_equiv with (c := (u17,(u19,u20,u18), u16)) in H as HH; [ | done].
+ destruct HH as [cs_FEL HH].
+ rewrite HH.
+ cbn [fst snd bind inv and2 or2]; fast_simpl_bool.
+ rewrite (surjective_pairing (step memqueue' (u12,c,u11) _)).
+ cbv [fst snd]; fast_simpl_bool.
+ rewrite incrn_pointr_true_equiv.
+ rewrite incrn_pointr_false_equiv; clear HH.
+ (* The second logic doesn't really matter much *)
+ rewrite (surjective_pairing (step FullEmptyLogic _ _)).
+ eapply ex_intro.
+ apply pair_equal_spec; split; [ | reflexivity].
+ apply pair_equal_spec; split; [ reflexivity | ].
+ destruct_pair_let.
+ cbv [memqueue' Memory' mem_write mem_read].
+ cbn [step fst snd]; simpl_ret.
+ rewrite (surjective_pairing (step (mem_cells _ _ _ _) c _)).
+ specialize @Cells_data_match with (T := Vec Bit (@REQUEST_WIDTH CAVA_SYS))
+ (W := @ADDR_WIDTH CAVA_SYS) (N := (Nat.pow 2 (@ADDR_WIDTH CAVA_SYS))) (I := InitMem)
+ (S0 := c) (we := true) (wa := (N.to_nat (Bv2N wra))) (wd := c_req) as HH.
+ rewrite -HH //=.
+ all: admit.
+ Admitted. *)
+
+ (* For the queue part *)
+ Lemma NF_ad_diff wra rda:
+ ~~ (fullQueue wra rda) -> wra <> rda ->
+ N2Bv_sized ADDR_WIDTH (Bv2N wra + 1) <> rda.
+ Admitted.
+
+ Theorem SM_Eq_1b (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) r0 r1:
+ (nat_of_ord c1 == PREA_date - 1) = true ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R != nullreq -> EqReq R c_req -> State_Eq (IDLE c0 c1 (r0 :: r1)) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 (r0 :: r1)) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Proof.
+ intros Href_prea f_state R NF EqR H; unfold FIFOSM.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ cbv [get_wra get_rda] in NFULL; rewrite NF in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
+ rewrite /State_Eq in H.
+ cbv [get_st get_cnt get_cref get_reqqueue get_addr_RequestQueue get_pop] in H.
+ unfold EqMem in H; cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells get_cr] in H.
+ (* unfold EqQueue in H; cbn [fst snd] in H. *)
+ move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr] /eqP EqPop].
+ cbn [fst snd] in Hadr.
+ simpl in Hadr.
+
+ destruct r1 eqn:Hr1; simpl in Hadr.
+ destruct (r0 == nullreq) eqn:Hr0.
+
+ (* apply negb_true_iff in Hadr; apply BVEq_iff_neq in Hadr. *)
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref; subst s cnt cref pop.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ specialize (RQ_snd_pushT_popF_NF_nempty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req) as S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
+ apply S in NFULL as S'; [ | done]; clear S; destruct S' as [full_o H].
+ rewrite H. clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ specialize (NextCR_equiv_IDLE_NE_PREA (u9, (u10, cr)) (cnt2Bv c0) (cref2Bv c1) tr) as S.
+ assert ((cref2Bv c1 =? CNT_REF_PREA) = true) as Href_prea_.
+ { move: Href_prea => /eqP Href_prea; apply BVEq_iff_eq.
+ rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct; f_equal.
+ by rewrite Href_prea.
+ }
+ apply S in Href_prea_ as S'; clear S; destruct S' as [cs_nextcr H].
+ rewrite H.
+
+ cbn [fst snd]; clear H.
+ apply (CmdGen_equiv_idle_to_ref u6 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
+ destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
+
+ apply (Update_equiv_idle_ref u4 (cnt2Bv c0) (cref2Bv c1) false) in Href_prea_ as H.
+ destruct H as [cs_update H]; rewrite H; clear H; cbn [fst snd].
+
+ rewrite /Next_state Href_prea /State_Eq.
+ specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
+ apply S in NFULL as H; clear S.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ cbv [get_st get_cref get_reqqueue get_addr_RequestQueue get_pop].
+
+ apply /andP; split.
+ 2 : exact EqReqNil.
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2: {
+ rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; simpl; trivial. }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
+ cbv [EqQueue Enqueue]; simpl.
+ apply NF_ad_diff in NFULL; [ | done].
+ apply /negPf; by apply BVEq_iff_neq.
+ }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
+ cbn [fst snd]; unfold EqMem, Enqueue; simpl; rewrite Hrw.
+ cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
+ unfold EqMem_ in Mem.
+ destruct (r0 == _); fold @EqMem_ in Mem.
+ {
+ admit.
+ }
+ { assert (((size (r1 ++ [R])).+1 == 1) = false); [ admit | ].
+ rewrite H0.
+ destruct (size (r0 :: r1) == 1).
+ { simpl.
+
+ }
+ move: Mem => /andP [EqR_ Mem].
+ apply /andP; split.
+ { admit. }
+ { admit. }
+ }
+
+ destruct (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? wra) eqn:HH.
+ { apply BVEq_iff_eq in HH; rewrite HH.
+ assert ((wra =? N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) = false) as H0; [admit | ].
+ rewrite H0.
+ destruct (r0 == _).
+ { fold @EqMem_ in Mem.
+ admit. }
+ { apply /andP; split.
+ { admit. (* (Cells_data c)[@rda] = (Cells_read ...)[@rda] *) }
+ { admit. }}}
+ { assert ((N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) = false) as H0; [admit | ].
+ rewrite H0.
+ destruct (r0 == _); fold @EqMem_ in Mem.
+ { admit. }
+ { }
+
+ }
+ assert ((N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? N2Bv_sized ADDR_WIDTH (Bv2N wra + 1)) = false). { admit. }
+ rewrite H0.
+ destruct (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? wra) eqn:HH.
+ { destruct (r0 == _).
+ {
+
+ }
+
+ }
+ destruct (N2Bv_sized ADDR_WIDTH (Bv2N rda + 1) =? _).
+ unfold EqMem_ in Mem.
+ destruct (r0 == nullreq).
+ 2: {
+ move: Mem => /andP [EqR_ Mem].
+ apply /andP; split. { (* EqR_ *) admit. }
+ fold @EqMem_ in Mem.
+ assert (EqMem_)
+ rewrite cats1 /rcons.
+ admit.
+ }
+ fold @EqMem_ in Mem.
+ admit.
+ }
+ apply /andP; split.
+ 2 : {
+ cbv [get_cref].
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //= VectorSpec.map_id.
+ destruct_pair_let.
+ rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
+ }
+ cbv [get_st]; rewrite (surjective_pairing (step RequestQueue' _ _)) H //=; destruct_pair_let.
+ by [].
+ Admitted.
+
+ Theorem SM_Eq_1a (t : nat) (c_state : State_t) c0 c1 (c_req : Bvector REQUEST_WIDTH) :
+ (nat_of_ord c1 == PREA_date - 1) = true ->
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R != nullreq -> EqReq R c_req -> State_Eq (IDLE c0 c1 []) c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R (IDLE c0 c1 []) in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Proof.
+ intros Href_prea f_state R NF EqR H; unfold FIFOSM.
+ unfold R in NF; specialize (HaltIfFull t c_state) as NFULL.
+ unfold State_t in c_state; simpl in c_state; destruct_products.
+ cbv [get_wra get_rda] in NFULL; rewrite NF in NFULL.
+ rename t0 into s, t1 into cnt, t2 into cref, t3 into cr, t4 into wra, t5 into rda, b into pop.
+ rewrite /State_Eq in H.
+ cbv [get_st get_cnt get_cref get_reqqueue get_addr_RequestQueue get_pop] in H.
+ unfold EqMem in H; cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells get_cr] in H.
+ unfold EqQueue in H; cbn [fst snd] in H.
+ move: H => /andP [/andP [/andP [/andP [/andP [EqS EqCnt] EqCref] Mem] Hadr] /eqP EqPop].
+ apply BVEq_iff_eq in EqS, EqCnt, EqCref, Hadr; subst s cnt cref pop.
+ cbv [LoopInit]; cbn [step fst snd]; simpl_ret.
+
+ rewrite (surjective_pairing (step RequestQueue' _ _)).
+ specialize (RQ_snd_pushT_empty ((u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21), (u14, (u16, (u18, u19, u17), u15)),u13, rda), wra))) c_req false) as S.
+ cbv [get_addr_RequestQueue get_memcells_RequestQueue get_mem_RequestQueue get_memcells] in S.
+ apply S in Hadr as H; clear S.
+ destruct H as [full_o H]; rewrite H.
+ clear H; cbn [fst snd].
+
+ set tr := nth_default req_null (N.to_nat (Bv2N rda)) _.
+ specialize NextCR_equiv with (c := (u9, (u10, cr))) (cnt := cnt2Bv c0)
+ (cref := cref2Bv c1) (tr := tr) as [cs_nextcr H].
+ rewrite H; cbv [fst]; clear H.
+
+ cbn [snd].
+ assert ((cref2Bv c1 =? CNT_REF_PREA) = true) as Href_prea_.
+ { move: Href_prea => /eqP Href_prea; apply BVEq_iff_eq.
+ rewrite /cref2Bv /CNT_REF_PREA bitvec_literal_correct; f_equal.
+ by rewrite Href_prea.
+ }
+ apply (CmdGen_equiv_idle_to_ref u6 (cnt2Bv c0)) in Href_prea_ as H.
+ destruct H as [cs_CmdGen H]; rewrite H; clear H; cbn [snd].
+
+ apply (Update_equiv_idle_ref u4 (cnt2Bv c0) (cref2Bv c1)) in Href_prea_ as H.
+ destruct H as [cs_update H]; rewrite H; clear H.
+
+ rewrite /Next_state Href_prea /State_Eq.
+ specialize RQ_fst_pushT_popF_NF with (c := (u11,(u12,(u26, (u27, (u29, (u31, u32, u30), u28)), u25,
+ (u24, c, u23), u22, (u20, u21),(u14, (u16, (u18, u19, u17), u15)), u13, rda), wra))) (c_req := c_req) as S.
+ apply S in NFULL as H; clear S.
+ destruct H as [cs_requeue' [Hx H]]; destruct Hx as [Hrw [Hwra' Hrda']].
+ cbv [get_st get_cref get_reqqueue get_addr_RequestQueue get_pop].
+
+ apply /andP; split.
+ 2 : exact EqReqNil.
+ apply /andP; split.
+ 2 : unfold EqCmd; by apply BVEq_iff_eq.
+ apply /andP; split.
+ 2: {
+ rewrite (surjective_pairing (step RequestQueue' _ _)); cbv [get_pop];
+ repeat lazymatch goal with
+ | |- context [ match ?p with pair _ _ => _ end ] => rewrite (surjective_pairing p)
+ end; simpl; trivial. }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hwra' Hrda'.
+ cbv [EqQueue Enqueue]; simpl.
+ unfold R; rewrite NF.
+ apply /negPf; apply BVEq_iff_neq; rewrite Hadr N.add_1_r.
+ specialize N2Bv_sized_neq_succ with (n := @ADDR_WIDTH CAVA_SYS) (x := Bv2N rda) as HH.
+ rewrite N2Bv_sized_Bv2N in HH; specialize ADDR_WIDTH_pos as H0; move: H0 => /ltP H0.
+ by apply HH in H0. }
+ apply /andP; split.
+ 2 : {
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H Hrda'.
+ unfold EqMem, Enqueue; simpl; rewrite andb_true_r.
+ destruct (R == _) eqn:HH; [ trivial | ].
+ rewrite Hrw; cbv [get_memcells_RequestQueue get_mem_RequestQueue get_memcells].
+ specialize (@nth_cells_read (Vec Bit REQUEST_WIDTH) ADDR_WIDTH InitMem rda c_req c) as H'.
+ rewrite Hadr H'; exact EqR.
+ }
+ apply /andP; split.
+ 2 : {
+ cbv [get_cref].
+ rewrite (surjective_pairing (step RequestQueue' _ _)) H //= VectorSpec.map_id.
+ destruct_pair_let.
+ rewrite /cref2Bv /OCycle0REF //=; by apply BVEq_iff_eq.
+ }
+ cbv [get_st]; rewrite (surjective_pairing (step RequestQueue' _ _)) H //=; destruct_pair_let.
+ by [].
+ Qed.
+
+ (* Have to add the full case *)
+ (* REF bounded with PREA_date or arbitrary parameter *)
+ (* if REF is bounded with PREA_date, a problem with cref + WAIT *)
+ (* try bound with random parameter, but will not be correspondent to Next_cycle *)
+ Theorem SM_Eq_NFULL (t : nat) (c_state : State_t) (f_req: Request_t)
+ (c_req : Bvector REQUEST_WIDTH) (push : bool) :
+ let f_state := (HW_Default_arbitrate t).(Implementation_State) in
+ let R := HW_Arrival_at t in
+ R != nullreq -> EqReq R c_req -> State_Eq f_state c_state ->
+ let '(f_nextstate,(f_cmd_o,f_req_o)) := Next_state R f_state in
+ let '(c_nextstate,(_,c_cmd_o,c_req_o)) := step FIFOSM c_state (true,c_req) in
+ (State_Eq f_nextstate c_nextstate) &&
+ (EqCmd f_cmd_o c_cmd_o) && (EqReq f_req_o c_req_o).
+ Proof.
+ destruct (f_state) eqn:Hf_state.
+ { destruct (nat_of_ord c0 == PREA_date - 1) eqn:Hcref_prea; move: Hcref_prea.
+ { destruct r eqn:HR.
+ { apply SM_Eq_1a. }
+ { admit. (* Case 1b: IDLE -> REFRESHING (non-empty queue)*) }
+ }
+ { destruct (c1 + WAIT < PREA_date) eqn:Hcref_service.
+ { destruct r eqn:HR.
+ { admit. (* Case 2a: IDLE -> IDLE (empty queue) *)}
+ { admit. (* Case 2b: IDLE -> RUNNING (non-empty queue) *)}
+ }
+ { destruct r eqn:HR.
+ { admit. (* Case 3a: IDLE -> IDLE (empty queue )*)}
+ { admit. (* Case 3b: IDLE -> IDLE (non empty queue) *) }
+ }
+ }
+ }
+ { destruct (nat_of_ord c0 == OACT_date) eqn:Hact_date.
+ { destruct r eqn:HR.
+ { admit. (* Case 4a : RUNNING -> RUNNING (ACT) (empty queue) *) }
+ { admit. (* Case 4b : RUNNING -> RUNNING (ACT) (non empty queue) *)}
+ }
+ { destruct (nat_of_ord c0 == OCAS_date) eqn:Hcas_date.
+ { destruct r eqn:HR.
+ { admit. (* Case 5a : RUNNING -> RUNNING (CAS) (empty queue )*) }
+ { admit. (* Case 5b : RUNNING -> RUNNING (CAS) (non-empty queue) *)}
+ }
+ { destruct (nat_of_ord c0 == WAIT.-1) eqn:Hend_date.
+ { destruct r eqn:HR.
+ { admit. (* Case 6a : RUNNING -> IDLE (empty queue) *) }
+ { admit. (* Case 6b : RUNNING -> IDLE (non empty queue) *)}
+ }
+ { destruct r eqn:HR.
+ { admit. (* Case 7a : RUNNING -> RUNNING (empty queue) *) }
+ { admit. (* Case 7b : RUNNING -> RUNNING (non empty queue) *) }
+ }
+ }
+ }
+ }
+ { destruct (nat_of_ord c0 == OREF_date) eqn:Href_date.
+ { destruct r eqn:HR.
+ { admit. }
+ { admit. }
+ }
+ { destruct (nat_of_ord c0 == OENDREF_date) eqn:Hendref_date.
+
+ }
+
+ }
+
+End EquivalenceProof.
\ No newline at end of file
--
GitLab