(* SPDX-License-Identifier: GPL-2.0 *)
Require Import List.
Import ListNotations.
(* From RecordUpdate Require Import RecordSet.
)Import RecordSetNotations. *)
(* Require Import PeanoNat. *)

Require Import Psatz.

Require Import WDRF.Base WDRF.Promising WDRF.DRF WDRF.SC.

Definition get_view (e : Event) : option View :=
    match e with
    | LOAD _ v _ => Some v
    | ACQ v _ => Some v
    | STORE _ v _ => Some v
    | REL v _ => Some v
    | _ => None
    end.

(* construct sc trace from promising trace *)
Inductive rel_global_trace : Trace -> list GlobalEvent -> Prop :=
| GT_EMPTY : forall n lp
                (Hempty : forall p, p <= n -> lp p = None),
                rel_global_trace (mkTrace n lp (fun _ => [])) []
| GT_INTERNAL : forall t gt i tid
                    (Hgt : rel_global_trace t gt),
                    rel_global_trace
                        (t
                            <|executions := update (executions t) tid (INTERNAL i :: (executions t tid)) |>
                        )
                        (GE tid (INTERNAL i) :: gt)
| GT_LOAD : forall t gt addr view reg tid
                    (Hgt : rel_global_trace t gt)
                    (Hlast : forall ms, rel_replay_mem (promiselen t) (promiselist t) ms -> Some (ms addr) = get_value view (promiselist t)),
                    rel_global_trace
                        (t
                            <|executions := update (executions t) tid (LOAD addr view reg :: (executions t tid)) |>
                        )
                        (GE tid (LOAD addr view reg) :: gt)
| GT_STORE : forall t gt addr view reg tid val
                    (Hgt : rel_global_trace t gt)
                    (Hmask : promiselist t view = None)
                    (Hlast : forall ms, rel_replay_mem (promiselen t) (promiselist t) ms ->
                        rel_replay_mem (promiselen t) (update (promiselist t) view (Some (WRITE tid val addr)))
                            (update ms addr val)
                    )
                    (Hunused : forall e tid, In e (executions t tid) -> get_view e <> Some view),
                    rel_global_trace
                        (t
                            <|promiselist := update (promiselist t) view (Some (WRITE tid val addr)) |>
                            <|executions := update (executions t) tid (STORE addr view reg :: (executions t tid)) |>
                        )
                        (GE tid (STORE addr view reg) :: gt)
(* ACQs and RELs are ignored in the global trace *)
| GT_ACQUIRE : forall t gt view addr tid
                    (Hgt : rel_global_trace t gt)
                    (Hmask : promiselist t view = None)
                    (Hlast : forall om n, rel_global_ownership n om (update (promiselist t) view (Some (PULL tid addr))) (fun _ => None) ->
                        exists om', rel_global_ownership n om' (promiselist t) (fun _ => None))
                    (Hunused : forall e tid, In e (executions t tid) -> get_view e <> Some view),
                    rel_global_trace
                        (t
                            <|promiselist := update (promiselist t) view (Some (PULL tid addr)) |>
                            <|executions := update (executions t) tid (ACQ view addr :: (executions t tid)) |>
                        )
                        gt
| GT_RELEASE : forall t gt view addr tid
                    (Hgt : rel_global_trace t gt)
                    (Hmask : promiselist t view = None)
                    (Hlast : forall om n, rel_global_ownership n om (update (promiselist t) view (Some (PUSH tid addr))) (fun _ => None) ->
                        exists om', rel_global_ownership n om' (promiselist t) (fun _ => None))
                    (Hunused : forall e tid, In e (executions t tid) -> get_view e <> Some view),
                    rel_global_trace
                        (t
                            <|promiselist := update (promiselist t) view (Some (PUSH tid addr)) |>
                            <|executions := update (executions t) tid (REL view addr :: (executions t tid)) |>
                        )
                        gt.

Inductive same_result : Trace -> list GlobalEvent -> Prop :=
| SAME_RESULT : forall t gt ms gs rs
                    (Hpamem : rel_replay_mem (promiselen t) (promiselist t) ms)
                    (Hpareg : forall tid, rel_replay_reg (promiselist t) (executions t tid) (rs tid))
                    (Hsc : rel_replay_sc gt gs)
                    (Hms : memstate gs = ms)
                    (Hreg : forall tid, regstates gs tid = rs tid)
                    ,
                    same_result t gt.

Lemma replay_mem_exists : forall lp n, exists ms, rel_replay_mem n lp ms.
Proof.
    intro. induction n.
    -   esplit. constructor.
    -   destruct IHn as (ms & Hms). destruct (lp (S n)) eqn:Hsn.
        +   destruct p.
            *   esplit.
                eapply REPLAY_MEM_WRITE. apply Hms. apply Hsn.
            *   esplit.
                eapply REPLAY_MEM_OTHER. apply Hms. rewrite Hsn. easy.
            *   esplit.
                eapply REPLAY_MEM_OTHER. apply Hms. rewrite Hsn. easy.
        +   esplit. eapply REPLAY_MEM_OTHER. apply Hms. rewrite Hsn. easy.
Qed.

Lemma replay_sc_exists : forall gt, exists gs, rel_replay_sc gt gs.
Proof.
    intro. induction gt.
    -   esplit. constructor.
    -   destruct a.
        destruct e; destruct IHgt as (gs & Hgs).
        {
            specialize (execute_internal_exists i (regstates gs tid)). intro. destruct H  as (rs & Hrs).
            esplit. constructor. apply Hgs. apply Hrs.
        }
        esplit; constructor; try apply Hgs.
        esplit; constructor; try apply Hgs.
        esplit; constructor; try apply Hgs.
        esplit; constructor; try apply Hgs.
Qed.

Lemma empty_replay_mem :
        forall n lp
            (Hempty : forall p : nat, p <= n -> lp p = None),
            rel_replay_mem n lp (fun addr => 0).
Proof.
    induction n; intros.
    -   constructor.
    -   apply REPLAY_MEM_OTHER. apply IHn.
        intros. apply Hempty. lia.
        rewrite Hempty. easy. easy.
Qed.

Lemma nth_error_inv :
        forall {T} (l : list T) n a b, nth_error (a :: l) n = Some b ->
            (n = 0 /\ a = b) \/ (exists n', n = S n' /\ nth_error l n' = Some b).
Proof.
    intros.
    destruct n.
    left. simpl in *. inversion H. easy.
    right. simpl in *. exists n. split. easy.
    assumption.
Qed.

Lemma localstate_promise_unused_write :
    forall tid pl ex ls view val addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hls : rel_promising tid (update pl view (Some (WRITE tid' val addr))) ex ls),
        rel_promising tid pl ex ls.
Proof.
    induction ex; intros.
    -   inversion Hls. constructor.
    -   inversion Hls.
        +   econstructor.
            eapply IHex.
            *   apply Hmask.
            *   intros. apply Hunused. simpl. auto.
            *   apply Hls0.
            *   apply Hexec.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. eapply Le.le_trans. apply previous_promise_incr.
            apply Hmask. apply Hbarrier.
            apply Hcoh.
            rewrite update_not_same in Hpromise. easy.
            specialize Hunused with a. intro. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   constructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. apply Hbarrier. apply Hcoh.
            rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
            apply Hbarrier.
Qed.

Lemma global_ownership_unused_write_aux :
    forall n omr pl view tid val addr om
        (Hmask : pl view = None)
        (Hom : rel_global_ownership n om (update pl view (Some (WRITE tid val addr))) omr),
        rel_global_ownership n om pl omr.
Proof.
    induction n; intros.
    -   inversion Hom. constructor.
    -   inversion Hom.
        +   constructor. eapply IHn.
            apply Hmask. apply Hlp. apply Hown.
            rewrite <- Hlp0. rewrite update_not_same. easy.
            intro. subst. rewrite update_same in Hlp0. discriminate.
        +   econstructor. eapply IHn.
            apply Hmask. apply Hlp. apply Hown.
            rewrite <- Hlp0. rewrite update_not_same. easy.
            intro. subst. rewrite update_same in Hlp0. discriminate.
        +   destruct (Peano_dec.eq_nat_dec view (S n)).
            *   apply GO_NONE. eapply IHn. apply Hmask. apply Hlp.
                subst. apply Hmask.
            *   eapply GO_WRITE. eapply IHn.
            apply Hmask. apply Hlp. apply Hown.
            rewrite update_not_same in Hlp0 by easy.
            apply Hlp0.
        +   destruct (Peano_dec.eq_nat_dec view (S n)).
            *   apply GO_NONE. eapply IHn. apply Hmask. apply Hlp.
                subst. apply Hmask.
            *   eapply GO_NONE. eapply IHn.
            apply Hmask. apply Hlp.
            rewrite update_not_same in Hlp0 by easy.
            apply Hlp0.
Qed.

Lemma global_ownership_unused_write :
    forall n pl view tid val addr om
        (Hmask : pl view = None)
        (Hom : rel_global_ownership n om (update pl view (Some (WRITE tid val addr))) (fun _ => None)),
        rel_global_ownership n om pl (fun _ => None).
Proof.
    intros. eapply global_ownership_unused_write_aux.
    apply Hmask. apply Hom.
Qed.

Lemma local_ownership_unused_write :
    forall pl ex lo view val addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hlo : rel_local_ownership (update pl view (Some (WRITE tid' val addr))) ex lo),
        rel_local_ownership pl ex lo.
Proof.
    induction ex; intros.
    -   inversion Hlo. constructor.
    -   inversion Hlo.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0.
Qed.

Lemma regstate_write_unchanged :
    forall pl ex view tid addr rs val
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hrs : rel_replay_reg pl ex rs),
        rel_replay_reg (update pl view (Some (WRITE tid val addr))) ex rs.
Proof.
    induction ex; intros.
    -   inversion Hrs. constructor.
    -   inversion Hrs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. apply Hinternal.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
Qed.

Lemma localstate_promise_unused_pull :
    forall tid pl ex ls view addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hls : rel_promising tid (update pl view (Some (PULL tid' addr))) ex ls),
        rel_promising tid pl ex ls.
Proof.
    induction ex; intros.
    -   inversion Hls. constructor.
    -   inversion Hls.
        +   econstructor.
            eapply IHex.
            *   apply Hmask.
            *   intros. apply Hunused. simpl. auto.
            *   apply Hls0.
            *   apply Hexec.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. eapply Le.le_trans. apply previous_promise_incr.
            apply Hmask. apply Hbarrier.
            apply Hcoh.
            rewrite update_not_same in Hpromise. easy.
            specialize Hunused with a. intro. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   constructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. apply Hbarrier. apply Hcoh.
            rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
            apply Hbarrier.
Qed.

Lemma local_ownership_unused_pull :
    forall pl ex lo view addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hlo : rel_local_ownership (update pl view (Some (PULL tid' addr))) ex lo),
        rel_local_ownership pl ex lo.
Proof.
    induction ex; intros.
    -   inversion Hlo. constructor.
    -   inversion Hlo.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0.
Qed.

Lemma memstate_pull_unchanged :
    forall n pl view ms tid addr
        (Hmask : pl view = None)
        (Hms : rel_replay_mem n pl ms),
        rel_replay_mem n (update pl view (Some (PULL tid addr))) ms.
Proof.
    induction n; intros.
    -   inversion Hms. constructor.
    -   inversion Hms.
        +   econstructor. apply IHn.
            apply Hmask. apply Hlp.
            rewrite update_not_same. apply Hwrite.
            intro. contradict Hwrite. subst. rewrite Hmask. easy.
        +   econstructor. apply IHn.
            apply Hmask. apply Hlp.
            destruct (Peano_dec.eq_nat_dec view (S n)).
            *   subst. rewrite update_same. easy.
            *   rewrite update_not_same by easy. apply Hnotwrite.
Qed.

Lemma regstate_pull_unchanged :
    forall pl ex view tid addr rs
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hrs : rel_replay_reg pl ex rs),
        rel_replay_reg (update pl view (Some (PULL tid addr))) ex rs.
Proof.
    induction ex; intros.
    -   inversion Hrs. constructor.
    -   inversion Hrs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. apply Hinternal.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
Qed.

Lemma localstate_promise_unused_push :
    forall tid pl ex ls view addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hls : rel_promising tid (update pl view (Some (PUSH tid' addr))) ex ls),
        rel_promising tid pl ex ls.
Proof.
    induction ex; intros.
    -   inversion Hls. constructor.
    -   inversion Hls.
        +   econstructor.
            eapply IHex.
            *   apply Hmask.
            *   intros. apply Hunused. simpl. auto.
            *   apply Hls0.
            *   apply Hexec.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. eapply Le.le_trans. apply previous_promise_incr.
            apply Hmask. apply Hbarrier.
            apply Hcoh.
            rewrite update_not_same in Hpromise. easy.
            specialize Hunused with a. intro. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   constructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. apply Hbarrier. apply Hcoh.
            rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
            apply Hbarrier.
Qed.

Lemma local_ownership_unused_push :
    forall pl ex lo view addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hlo : rel_local_ownership (update pl view (Some (PUSH tid' addr))) ex lo),
        rel_local_ownership pl ex lo.
Proof.
    induction ex; intros.
    -   inversion Hlo. constructor.
    -   inversion Hlo.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0.
Qed.

Lemma regstate_push_unchanged :
    forall pl ex view tid addr rs
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hrs : rel_replay_reg pl ex rs),
        rel_replay_reg (update pl view (Some (PUSH tid addr))) ex rs.
Proof.
    induction ex; intros.
    -   inversion Hrs. constructor.
    -   inversion Hrs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. apply Hinternal.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
Qed.

Lemma memstate_push_unchanged :
    forall n pl view ms tid addr
        (Hmask : pl view = None)
        (Hms : rel_replay_mem n pl ms),
        rel_replay_mem n (update pl view (Some (PUSH tid addr))) ms.
Proof.
    induction n; intros.
    -   inversion Hms. constructor.
    -   inversion Hms.
        +   econstructor. apply IHn.
            apply Hmask. apply Hlp.
            rewrite update_not_same. apply Hwrite.
            intro. contradict Hwrite. subst. rewrite Hmask. easy.
        +   econstructor. apply IHn.
            apply Hmask. apply Hlp.
            destruct (Peano_dec.eq_nat_dec view (S n)).
            *   subst. rewrite update_same. easy.
            *   rewrite update_not_same by easy. apply Hnotwrite.
Qed.

Theorem same_mem :
    forall (t : Trace) (gt : list GlobalEvent)
        (Hsc : rel_global_trace t gt)
        (Hvalid : valid_trace t)
        (Hdrf : DRF t)
        ,
        same_result t gt.
Proof.
    intros. induction Hsc.
    -   (* empty *)
        esplit; simpl in *.
        +   apply empty_replay_mem. easy.
        +   intro. apply REPLAY_REG_EMPTY.
        +   apply SC_EMPTY.
        +   simpl. reflexivity.
        +   simpl. easy.
    -   (* internal *)
        assert (same_result t gt) as IHsame.
        {
            apply IHHsc.
            inversion Hvalid. simpl in *.
            -   constructor.
                +   unfold fulfilled in *. simpl in *. intros v Hp.
                    specialize Hfulfilled with v. apply Hfulfilled in Hp.
                    destruct Hp as (tid0 & e & n & Hp1 & Hp2 & Hp3).
                    destruct (promiselist t v) eqn: Heqp; try easy.
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                    *   subst. rewrite update_same in Hp1.
                        apply nth_error_inv in Hp1 as [|].
                        {   destruct H. subst.
                            destruct p; destruct Hp2; try easy.
                            destruct H0. easy.
                        }
                        {exists tid0, e.
                            destruct H as (n0 & Hn01 & Hn02).
                            exists n0.
                            split. easy. split. easy.
                            intros.
                            destruct (Peano_dec.eq_nat_dec tid0 tid').
                            - rewrite e0 in *.
                                specialize Hp3 with tid' (S n') e'.
                                rewrite update_same in Hp3. rewrite Hn01 in Hp3.
                                split; auto.
                                assert (S n0 = S n') by now apply Hp3.
                                inversion H. easy.
                            - specialize Hp3 with tid' n' e'.
                                rewrite update_not_same in Hp3 by lia.
                                apply Hp3  in He'; easy.
                        }
                    *   rewrite update_not_same in Hp1 by easy.
                        exists tid0, e, n. split. easy.
                        split. easy. intros.
                        destruct (Peano_dec.eq_nat_dec tid tid').
                        {   rewrite <- e0 in *.
                            specialize Hp3 with tid (S n') e'.
                            rewrite update_same in Hp3.
                            contradict n0. symmetry. apply Hp3.
                            simpl. easy. easy.
                        }
                        {   apply Hp3 with e'.
                            rewrite update_not_same by easy. easy. easy.

                        }
                +   intro. specialize Hconsistent with tid0. destruct Hconsistent as (ls1 & Hls1).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                    *   subst. rewrite update_same in Hls1.
                        inversion Hls1; exists ls; easy.
                    *   rewrite update_not_same in Hls1 by easy.
                        exists ls1. easy.
            -   (* DRF *)
                inversion Hdrf. simpl in *.
                esplit. apply Hglobal.
                intro. specialize Hlocal with tid0. destruct Hlocal as (lo & Hlo).
                destruct (Peano_dec.eq_nat_dec tid tid0).
                  subst. rewrite update_same in Hlo.
                    inversion Hlo. exists lo. easy.
                  rewrite update_not_same in Hlo by easy.
                    exists lo. easy.
        }
        clear IHHsc. inversion IHsame.
        destruct (execute_internal_exists i (rs tid)) as (r0 & Hr0).
        set (rs0 := update rs tid r0).
        replace r0 with (rs0 tid) in Hr0 by now unfold rs0; rewrite update_same.
        esplit; simpl in *.
        +   apply Hpamem.
        +   intro. specialize Hpareg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst tid0. rewrite update_same.
                econstructor. apply Hpareg.
                apply Hr0.
            *   rewrite update_not_same by easy.
                replace (rs0 tid0) with (rs tid0).
                apply Hpareg. unfold rs0. rewrite update_not_same by easy.
                reflexivity.
        +   constructor. apply Hsc0.
            rewrite Hreg. apply Hr0.
        +   simpl. apply Hms.
        +   simpl. intro. specialize Hreg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst tid0. rewrite update_same. reflexivity.
            *   unfold rs0.
                rewrite update_not_same by easy.
                rewrite update_not_same by easy.
                apply Hreg.
    -   (* LOAD *)
        assert (same_result t gt) as IHsame.
        {
            apply IHHsc.
            -   inversion Hvalid. constructor.
                +   unfold fulfilled in *. simpl in *. intros v Hp.
                    specialize Hfulfilled with v. apply Hfulfilled in Hp.
                    destruct Hp as (tid0 & e & n & Hp1 & Hp2 & Hp3).
                    destruct (promiselist t v) eqn: Heqp; try easy.
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                    *   subst. rewrite update_same in Hp1.
                        apply nth_error_inv in Hp1 as [|].
                          destruct H. subst.
                            destruct p; destruct Hp2; try easy.
                            destruct H0. easy.
                          exists tid0, e.
                            destruct H as (n0 & Hn01 & Hn02).
                            exists n0.
                            split. easy. split. easy.
                            intros.
                            destruct (Peano_dec.eq_nat_dec tid0 tid').
                             rewrite e0 in *.
                                specialize Hp3 with tid' (S n') e'.
                                rewrite update_same in Hp3. rewrite Hn01 in Hp3.
                                split; auto.
                                assert (S n0 = S n') by now apply Hp3.
                                inversion H. easy.
                             specialize Hp3 with tid' n' e'.
                                rewrite update_not_same in Hp3 by lia.
                                apply Hp3  in He'; easy.
                    *   rewrite update_not_same in Hp1 by easy.
                        exists tid0, e, n. split. easy.
                        split. easy. intros.
                        destruct (Peano_dec.eq_nat_dec tid tid').
                          rewrite <- e0 in *.
                            specialize Hp3 with tid (S n') e'.
                            rewrite update_same in Hp3.
                            contradict n0. symmetry. apply Hp3.
                            simpl. easy. easy.
                          apply Hp3 with e'.
                            rewrite update_not_same by easy. easy. easy.
                +   intro. simpl in *.
                    specialize Hconsistent with tid0. destruct Hconsistent as (ls & Hls).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                    *   subst. rewrite update_same in Hls.
                        inversion Hls. exists ls0. easy.
                    *   rewrite update_not_same in Hls by easy.
                        exists ls. easy.
            -   inversion Hdrf. simpl in *. esplit.
                apply Hglobal.
                intro. specialize Hlocal with tid0.
                destruct (Peano_dec.eq_nat_dec tid tid0).
                +   subst. rewrite update_same in Hlocal.
                    destruct Hlocal as (lo & Hlo).
                    inversion Hlo. exists lo. apply Hlo0.
                +   rewrite update_not_same in Hlocal by easy.
                    apply Hlocal.
        }
        clear IHHsc. inversion IHsame.
        inversion Hvalid.
        destruct (Hconsistent tid) as (ls & Hls). simpl in *.
        rewrite update_same in Hls.
        inversion Hls.
        set (rs0 := update rs tid (update (rs tid) reg val)).
        esplit; simpl in *.
        +   apply Hpamem.
        +   subst.
            instantiate (1:= update rs tid (update (rs tid) reg val)).
            intro. specialize Hpareg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst. simpl in *. rewrite update_same.
                unfold rs0. rewrite update_same.
                constructor. assumption.
                unfold get_value. rewrite Hpromise. easy.
            *   unfold rs0.
                repeat rewrite update_not_same by easy.
                easy.
        +   constructor. apply Hsc0.
        +   easy.
        +   simpl. intro.
            destruct (Peano_dec.eq_nat_dec tid tid1).
            *   rewrite Hreg. rewrite Hms.
                rewrite e.
                repeat rewrite update_same.
                assert (ms addr = val). (* last read *)
                {
                    apply Hlast in Hpamem.
                    unfold get_value in *. rewrite Hpromise in Hpamem.
                    inversion Hpamem. reflexivity.
                }
                subst. easy.
            *   subst.
                repeat rewrite update_not_same by easy. rewrite Hreg. easy.
    -   (* STORE *)
        assert (same_result t gt) as IHsame.
        {
            apply IHHsc.
            inversion Hvalid. simpl in *.
            -   constructor.
                +   unfold fulfilled in *. simpl in *. intros v Hp.
                    specialize Hfulfilled with v.
                    destruct (Peano_dec.eq_nat_dec v view).
                    *   rewrite e in *.
                        rewrite Hmask in *. destruct Hp. easy.
                    *   rewrite update_not_same in Hfulfilled by lia.
                        apply Hfulfilled in Hp.
                        destruct Hp as (tid0 & e & n0 & He & Hp1 & Hp2).
                        exists tid0, e.
                        destruct (Peano_dec.eq_nat_dec tid tid0).
                          rewrite <- e0 in *. rewrite update_same in He.
                            apply nth_error_inv in He as [|].
                              destruct H0. subst.
                                destruct (promiselist t v); try easy.
                                destruct p. destruct Hp1 as (_ & reg0 & Hreg).
                                inversion Hreg. contradict n. easy. easy.
                                destruct Hp1. discriminate.
                              destruct H0 as (n' & Hn'1 & Hn'2).
                                exists n'. split. easy. split. easy.
                                intros.
                                destruct (Peano_dec.eq_nat_dec tid tid').
                                  rewrite <- e1 in *.
                                    specialize Hp2 with tid (S n'0) e'.
                                    rewrite update_same in Hp2.
                                    rewrite Hn'1 in *.
                                    assert (S n' = S n'0) by now apply Hp2.
                                    auto.
                                  specialize Hp2 with tid' n'0 e'.
                                    rewrite update_not_same in Hp2 by lia.
                                    contradict n1. apply Hp2. easy. easy.
                          rewrite update_not_same in He by easy.
                            exists n0. split. easy. split. easy.
                            intros. destruct (Peano_dec.eq_nat_dec tid tid').
                              specialize Hp2 with tid (S n') e'. rewrite <- e0 in *.
                                rewrite update_same in Hp2.
                                contradict n1. symmetry. apply Hp2.
                                simpl. easy. easy.
                              specialize Hp2 with tid' n' e'.
                                rewrite update_not_same in Hp2 by easy.
                                apply Hp2. easy. easy.
                +   intro. specialize Hconsistent with tid0. destruct Hconsistent as (ls1 & Hls1).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hls1.
                        inversion Hls1. exists ls.
                        eapply localstate_promise_unused_write.
                          apply Hmask.
                          intros. eapply Hunused. apply H6.
                          apply Hls.
                      rewrite update_not_same in Hls1 by easy.
                        exists ls1.
                        eapply localstate_promise_unused_write.
                        apply Hmask. intros. eapply Hunused. apply H0. apply Hls1.
            -   (* DRF *)
                inversion Hdrf. simpl in *.
                esplit.
                +   inversion Hglobal. eexists. eapply global_ownership_unused_write.
                    apply Hmask. apply H0. (* last write *)
                +   intro. specialize Hlocal with tid0. destruct Hlocal  as (lo & Hlo).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hlo.
                        inversion Hlo. exists lo0.
                        eapply local_ownership_unused_write. apply Hmask.
                        intros. eapply Hunused. apply H5. subst. apply Hlo0.
                      rewrite update_not_same in Hlo by easy.
                        exists lo.
                        eapply local_ownership_unused_write. apply Hmask.
                        intros. eapply Hunused. apply H0. subst. apply Hlo.
        }
        clear IHHsc. inversion IHsame.
        esplit; simpl in *.
        +   apply Hlast. apply Hpamem.
        +   intro. specialize Hpareg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst. rewrite update_same.
                apply REPLAY_REG_STORE.
                eapply regstate_write_unchanged. apply Hmask.
                intros. eapply Hunused. apply H. apply Hpareg.
                unfold get_value. rewrite update_same.
                inversion Hvalid.
                specialize Hconsistent with tid0. destruct Hconsistent.
                simpl in *. rewrite update_same in H0. inversion H0.
                rewrite update_same in Hpromise. inversion Hpromise.
                erewrite rel_promising_localstate. reflexivity.
                apply Hls. apply regstate_write_unchanged.
                apply Hmask. intro. apply Hunused. easy.
            *   rewrite update_not_same by easy.
                eapply regstate_write_unchanged. apply Hmask.
                intros. eapply Hunused. apply H1. apply Hpareg.
        +   constructor. apply Hsc0.
        +   simpl. rewrite Hreg. rewrite Hms.
            replace (rs tid reg) with val. easy.
            inversion Hvalid. specialize Hconsistent with tid.
            destruct Hconsistent. simpl in *. rewrite update_same in H2.
            inversion H2. rewrite update_same in Hpromise. inversion Hpromise.
            erewrite rel_promising_localstate. reflexivity.
            apply Hls. apply regstate_write_unchanged. apply Hmask.
            intro. eapply Hunused. easy.
        +   simpl. intro. specialize Hreg with tid0.
            apply Hreg.
    -   (* ACQ *)
        assert (same_result t gt) as IHsame.
        {
            apply IHHsc.
            inversion Hvalid. simpl in *.
            -   constructor.
                +   unfold fulfilled in *. simpl in *. intros v Hp.
                    specialize Hfulfilled with v.
                    destruct (Peano_dec.eq_nat_dec v view).
                    *   rewrite e in *.
                        rewrite Hmask in *. destruct Hp. easy.
                    *   rewrite update_not_same in Hfulfilled by lia.
                        apply Hfulfilled in Hp.
                        destruct Hp as (tid0 & e & n0 & He & Hp1 & Hp2).
                        exists tid0, e.
                        destruct (Peano_dec.eq_nat_dec tid tid0).
                          rewrite <- e0 in *. rewrite update_same in He.
                            apply nth_error_inv in He as [|].
                              destruct H0. subst.
                                destruct (promiselist t v); try easy.
                                destruct p. destruct Hp1 as (_ & reg & Hreg). discriminate.
                                destruct Hp1. inversion H0. contradict n. easy. easy.
                              destruct H0 as (n' & Hn'1 & Hn'2).
                                exists n'. split. easy. split. easy.
                                intros.
                                destruct (Peano_dec.eq_nat_dec tid tid').
                                  rewrite <- e1 in *.
                                    specialize Hp2 with tid (S n'0) e'.
                                    rewrite update_same in Hp2.
                                    rewrite Hn'1 in *.
                                    assert (S n' = S n'0) by now apply Hp2.
                                    auto.
                                  specialize Hp2 with tid' n'0 e'.
                                    rewrite update_not_same in Hp2 by lia.
                                    contradict n1. apply Hp2. easy. easy.
                          rewrite update_not_same in He by easy.
                            exists n0. split. easy. split. easy.
                            intros. destruct (Peano_dec.eq_nat_dec tid tid').
                              specialize Hp2 with tid (S n') e'. rewrite <- e0 in *.
                                rewrite update_same in Hp2.
                                contradict n1. symmetry. apply Hp2.
                                simpl. easy. easy.
                              specialize Hp2 with tid' n' e'.
                                rewrite update_not_same in Hp2 by easy.
                                apply Hp2. easy. easy.
                +   intro. specialize Hconsistent with tid0. destruct Hconsistent as (ls1 & Hls1).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hls1.
                        inversion Hls1. exists ls.
                        eapply localstate_promise_unused_pull.
                        apply Hmask. intros. eapply Hunused. apply H5. apply Hls.
                      rewrite update_not_same in Hls1 by easy.
                        exists ls1. eapply localstate_promise_unused_pull.
                        apply Hmask. intros. eapply Hunused. apply H0. apply Hls1.
            -   (* DRF *)
                inversion Hdrf. simpl in *.
                esplit.
                +   inversion Hglobal. eapply Hlast. apply H0.
                +   intro. specialize Hlocal with tid0. destruct Hlocal as (lo & Hlo).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hlo.
                        inversion Hlo. exists lo0.
                        eapply local_ownership_unused_pull.
                        apply Hmask. intros. eapply Hunused. apply H4.
                        apply Hlo0.
                      rewrite update_not_same in Hlo by easy.
                        exists lo. eapply local_ownership_unused_pull.
                        apply Hmask. intros. eapply Hunused. apply H0. subst. apply Hlo.
        }
        clear IHHsc. inversion IHsame.
        esplit; simpl in *.
        +   apply memstate_pull_unchanged. apply Hmask. apply Hpamem.
        +   instantiate (1:= rs).
            intro. specialize Hpareg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst. rewrite update_same.
                constructor.
                apply regstate_pull_unchanged. apply Hmask.
                intros. eapply Hunused. apply H. apply Hpareg.
            *   rewrite update_not_same by easy.
                apply regstate_pull_unchanged. apply Hmask.
                intros. eapply Hunused. apply H1. apply Hpareg.
        +   apply Hsc0.
        +   simpl. apply Hms.
        +   simpl. intro. specialize Hreg with tid0.
            apply Hreg.
    -   (* REL *)
        assert (same_result t gt) as IHsame.
        {
            apply IHHsc.
            inversion Hvalid. simpl in *.
            -   constructor.
                +   unfold fulfilled in *. simpl in *. intros v Hp.
                    specialize Hfulfilled with v.
                    destruct (Peano_dec.eq_nat_dec v view).
                    *   rewrite e in *.
                        rewrite Hmask in *. destruct Hp. easy.
                    *   rewrite update_not_same in Hfulfilled by lia.
                        apply Hfulfilled in Hp.
                        destruct Hp as (tid0 & e & n0 & He & Hp1 & Hp2).
                        exists tid0, e.
                        destruct (Peano_dec.eq_nat_dec tid tid0).
                          rewrite <- e0 in *. rewrite update_same in He.
                            apply nth_error_inv in He as [|].
                              destruct H0. subst.
                                destruct (promiselist t v); try easy.
                                destruct p. destruct Hp1 as (_ & reg & Hreg). discriminate.
                                easy.
                                destruct Hp1. inversion H0. contradict n. easy.
                              destruct H0 as (n' & Hn'1 & Hn'2).
                                exists n'. split. easy. split. easy.
                                intros.
                                destruct (Peano_dec.eq_nat_dec tid tid').
                                  rewrite <- e1 in *.
                                    specialize Hp2 with tid (S n'0) e'.
                                    rewrite update_same in Hp2.
                                    rewrite Hn'1 in *.
                                    assert (S n' = S n'0) by now apply Hp2.
                                    auto.
                                  specialize Hp2 with tid' n'0 e'.
                                    rewrite update_not_same in Hp2 by lia.
                                    contradict n1. apply Hp2. easy. easy.
                          rewrite update_not_same in He by easy.
                            exists n0. split. easy. split. easy.
                            intros. destruct (Peano_dec.eq_nat_dec tid tid').
                              specialize Hp2 with tid (S n') e'. rewrite <- e0 in *.
                                rewrite update_same in Hp2.
                                contradict n1. symmetry. apply Hp2.
                                simpl. easy. easy.
                              specialize Hp2 with tid' n' e'.
                                rewrite update_not_same in Hp2 by easy.
                                apply Hp2. easy. easy.
                +   intro. specialize Hconsistent with tid0. destruct Hconsistent as (ls1 & Hls1).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hls1.
                        inversion Hls1. exists ls.
                        eapply localstate_promise_unused_push.
                        apply Hmask. intros. eapply Hunused. apply H5. rewrite H1. apply Hls.
                      rewrite update_not_same in Hls1 by easy.
                        exists ls1. eapply localstate_promise_unused_push.
                        apply Hmask. intros. eapply Hunused. apply H0. apply Hls1.
            -   (* DRF *)
                inversion Hdrf. simpl in *.
                esplit.
                +   inversion Hglobal. eapply Hlast. apply H0.
                +   intro. specialize Hlocal with tid0. destruct Hlocal as (lo & Hlo).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hlo.
                        inversion Hlo. exists lo0.
                        eapply local_ownership_unused_push.
                        apply Hmask. intros. eapply Hunused. apply H4.
                        apply Hlo0.
                      rewrite update_not_same in Hlo by easy.
                        exists lo. eapply local_ownership_unused_push.
                        apply Hmask. intros. eapply Hunused. apply H0. subst. apply Hlo.
        }
        clear IHHsc. inversion IHsame.
        esplit; simpl in *.
        +   apply memstate_push_unchanged. apply Hmask. apply Hpamem.
        +   instantiate (1:=rs).
            intro. specialize Hpareg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst. rewrite update_same.
                constructor.
                apply regstate_push_unchanged. apply Hmask.
                intros. eapply Hunused. apply H. apply Hpareg.
            *   rewrite update_not_same by easy.
                apply regstate_push_unchanged. apply Hmask.
                intros. eapply Hunused. apply H1. apply Hpareg.
        +   apply Hsc0.
        +   simpl. apply Hms.
        +   simpl. intro. specialize Hreg with tid0.
            apply Hreg.
Qed.


(** * Classification of morphisms of the Grothendieck Construction of a functor to Set *)
Require Import Category.Core Functor.Core.
Require Import Category.Morphisms.
Require Import SetCategory.Core.
Require Import Grothendieck.ToSet.Core.
Require Import HoTT.Basics HoTT.Types.

Set Universe Polymorphism.
Set Implicit Arguments.
Generalizable All Variables.
Set Asymmetric Patterns.

Local Open Scope morphism_scope.

Section Grothendieck.
  Context `{Funext}.
  Context {C : PreCategory}
          {F : Functor C set_cat}.

  Definition isequiv_sigma_category_isomorphism {s d : category F}
  : (s <~=~> d)%category <~> { e : (s.(c) <~=~> d.(c))%category | (F _1 e s.(x) = d.(x))%category }.
  Proof.
    simple refine (equiv_adjointify _ _ _ _).
    { intro m.
      simple refine (_; _).
      { exists (m : morphism _ _ _).1.
        exists (m^-1).1.
        { exact (ap proj1 (@left_inverse _ _ _ m _)). }
        { exact (ap proj1 (@right_inverse _ _ _ m _)). } }
      { exact (m : morphism _ _ _).2. } }
    { intro m.
      exists (m.1 : morphism _ _ _ ; m.2).
      eexists (m.1^-1;
               ((ap (F _1 (m.1)^-1) m.2)^)
                 @ (ap10 ((((composition_of F _ _ _ _ _)^)
                             @ (ap (fun m => F _1 m) (@left_inverse _ _ _ m.1 _))
                             @ (identity_of F _))
                          : (F _1 (m.1 : morphism _ _ _)^-1) o F _1 m.1 = idmap) s.(x)));
        apply path_sigma_hprop.
      - exact left_inverse.
      - exact right_inverse. }
    { intro x; apply path_sigma_hprop; apply path_isomorphic.
      reflexivity. }
    { intro x; apply path_isomorphic; reflexivity. }
  Defined.
End Grothendieck.


Require Import VST.floyd.proofauto.
Import ListNotations.
Local Open Scope logic.
Require Import VST.floyd.sublist.

Require Import sha.HMAC256_functional_prog.
Require Import sha.general_lemmas.
Require Import sha.spec_sha.

Require Import hmacdrbg.entropy.
Require Import hmacdrbg.entropy_lemmas.
Require Import hmacdrbg.DRBG_functions.
Require Import hmacdrbg.HMAC_DRBG_algorithms.
Require Import hmacdrbg.HMAC256_DRBG_functional_prog.
Require Import hmacdrbg.hmac_drbg.
Require Import hmacdrbg.HMAC_DRBG_pure_lemmas.
Require Import hmacdrbg.spec_hmac_drbg.
Require Import hmacdrbg.HMAC_DRBG_common_lemmas.
Require Import hmacdrbg.spec_hmac_drbg_pure_lemmas.
Require Import VST.floyd.library.

Require Import hmacdrbg.verif_hmac_drbg_seed_common.

Module Instantiate_eq.

Definition OptionalNonce: option (list Z) := None. (*The implementation takes nonce from entropy, using the el*3/2 calculation*)

(*NIST, Section 10.1: highest supported sec strength is given by the hash function's
security strength for preimage resistance. For SHA256, this is
(according to NIST SP 800-107, Table 1, page 11) 256 bits. See also Appendix B2 of NIST SP 800-90A. *)
Definition highest_supported_security_strength := 32. (* in bytes -- see comment for reseed*)

(*Q: should we use the sec strength of HMAC, calculated according to Section 5.3.4 of
NIST SP 800-107 instead?*)
Definition requested_security_strength:= 32.  (*same as in reseed*)

Definition prediction_resistance_supported:bool:=true.

Definition mbedtls_HMAC256_DRBG_instantiate_function (entropy_stream: ENTROPY.stream)
         entropy_len pr_flag (personalization_string: list Z): ENTROPY.result DRBG_state_handle :=
    HMAC256_DRBG_instantiate_function entropy_len entropy_len OptionalNonce
            highest_supported_security_strength max_personalization_string_length
            prediction_resistance_supported entropy_stream
            requested_security_strength pr_flag personalization_string.

Definition entlen:Z := 32.

Parameter Entropy_addSuccess1: forall n m s s1 l1 s2 l2,
        ENTROPY.get_bytes n s = ENTROPY.success l1 s1 ->
        ENTROPY.get_bytes m s1 = ENTROPY.success l2 s2 ->
        ENTROPY.get_bytes (n+m) s = ENTROPY.success (l1++l2) s2.

Parameter Entropy_addSuccess2: forall n m s s1 l1 s2 e,
        ENTROPY.get_bytes n s = ENTROPY.success l1 s1 ->
        ENTROPY.get_bytes m s1 = ENTROPY.error e s2 ->
        ENTROPY.get_bytes (n+m) s = ENTROPY.error e s2.

Parameter Entropy_addError: forall n m s s1 e, ENTROPY.get_bytes n s = ENTROPY.error e s1 ->
        ENTROPY.get_bytes (n+m) s = ENTROPY.error e s1.

Lemma Entropy_le n s l ss: ENTROPY.success l ss = ENTROPY.get_bytes n s ->
  forall m, (m <= n)%nat -> exists l' s', ENTROPY.success l' s' = ENTROPY.get_bytes m s.
Proof. intros.
  remember (ENTROPY.get_bytes m s) as d.
  destruct d. eexists; eexists; trivial.
  symmetry in H; symmetry in Heqd.
  specialize (Entropy_addError _ (n-m)%nat _ _ _ Heqd).
     rewrite le_plus_minus_r; trivial.
  intros HH; rewrite HH in *. discriminate.
Qed.

Lemma Entropy_addSuccess3: forall n m s ss l,
        ENTROPY.get_bytes n s = ENTROPY.success l ss -> (m <= n)%nat ->
        exists l1 s1, ENTROPY.get_bytes m s = ENTROPY.success l1 s1 /\
        exists l2, ENTROPY.get_bytes (n-m)%nat s1 = ENTROPY.success l2 ss /\ l=l1++l2.
Proof. intros.
  remember (ENTROPY.get_bytes m s). destruct r.
+ exists l0, s0; split; trivial.
  symmetry in Heqr.
  remember (ENTROPY.get_bytes (n-m)%nat s0) as t.
  destruct t; symmetry in Heqt.
  - specialize (Entropy_addSuccess1 m (n-m)%nat s s0). rewrite Heqr, Heqt, le_plus_minus_r; trivial.
    intros X. rewrite (X _ _ _ (eq_refl _) (eq_refl _)) in H; clear X Heqr Heqt. inv H. exists l1; split; trivial.
  - specialize (Entropy_addSuccess2 m (n-m)%nat s s0). rewrite Heqr, Heqt, le_plus_minus_r; trivial.
    intros X. rewrite (X _ _ _ (eq_refl _) (eq_refl _)) in H; clear X Heqr Heqt. inv H.
+ symmetry in Heqr; exfalso.
  specialize (Entropy_addError m (n-m)%nat s). rewrite Heqr, le_plus_minus_r; trivial.
  intros X. rewrite (X _ _ (eq_refl _)) in H. inv H.
Qed.

Lemma instantiate_eq es prflag pers:
      instantiate_function_256 es prflag pers =
      mbedtls_HMAC256_DRBG_instantiate_function es entlen prflag pers.
Proof. unfold instantiate_function_256, mbedtls_HMAC256_DRBG_instantiate_function,
   HMAC256_DRBG_instantiate_function, DRBG_instantiate_function, HMAC256_DRBG_instantiate_algorithm; simpl; intros.
destruct (Zlength pers >? max_personalization_string_length).
+ destruct prflag; trivial.
+ unfold entlen, get_entropy; simpl.
  remember (ENTROPY.get_bytes 48 es) as r.
  destruct r; symmetry in Heqr.
  - destruct (Entropy_addSuccess3 _ 32 _ _ _ Heqr) as [l1 [s1 [E32 [l2 [E16 L]]]]]. omega.
    simpl in E16. rewrite E32, E16; subst.
    unfold HMAC_DRBG_instantiate_algorithm. simpl. rewrite app_assoc. destruct prflag; trivial.
  - remember  (ENTROPY.get_bytes 32 es) as t; destruct t; symmetry in Heqt.
    * remember (ENTROPY.get_bytes 16 s0) as w; destruct w; symmetry in Heqw.
      ++ specialize (Entropy_addSuccess1 _ _ _ _ _ _ _ Heqt Heqw). simpl. rewrite Heqr. congruence.
      ++ specialize (Entropy_addSuccess2 _ _ _ _ _ _ _ Heqt Heqw). simpl. rewrite Heqr; intros X. inv X; destruct prflag; trivial.
    * specialize (Entropy_addError _ 16 _ _ _ Heqt). simpl. rewrite Heqr; intros X. inv X; destruct prflag; trivial.
Qed.

Lemma instantiate_reseed d s pr_flag rc ri (ZLc'256F : (Zlength d >? 256) = false):
      mbedtls_HMAC256_DRBG_instantiate_function s entlen pr_flag  d =
      mbedtls_HMAC256_DRBG_reseed_function s (HMAC256DRBGabs initial_key initial_value rc 48 pr_flag ri) d.
Proof. rewrite <- instantiate256_reseed, instantiate_eq; trivial. Qed.

Opaque mbedtls_HMAC256_DRBG_reseed_function.
Opaque initial_key. Opaque initial_value.
Opaque mbedtls_HMAC256_DRBG_reseed_function.
Opaque list_repeat.

(*specification for the expected case, in which 0<=len<=256.
  But use mbedtls_HMAC256_DRBG_instantiate_function PROP of PRE and assume SUCCESS*)
Definition hmac_drbg_seed_simple_spec :=
  DECLARE _mbedtls_hmac_drbg_seed
   WITH dp:_, ctx: val, info:val, len: Z, data:val, Data: list Z,
        Ctx: hmac256drbgstate,
        kv: val, Info: md_info_state, s:ENTROPY.stream, rc:Z, pr_flag:bool, ri:Z,
        handle_ss: DRBG_state_handle * ENTROPY.stream
    PRE [_ctx OF tptr (Tstruct _mbedtls_hmac_drbg_context noattr),
         _md_info OF tptr (Tstruct _mbedtls_md_info_t noattr),
         _custom OF tptr tuchar, _len OF tuint ]
       PROP (len = Zlength Data /\ 0 <= len <=256 /\ Forall isbyteZ Data /\
             mbedtls_HMAC256_DRBG_instantiate_function s entlen pr_flag
                                       (contents_with_add data (Zlength Data) Data)
             = ENTROPY.success (fst handle_ss) (snd handle_ss))
       LOCAL (temp _ctx ctx; temp _md_info info;
              temp _len (Vint (Int.repr len)); temp _custom data; gvar sha._K256 kv)
       SEP (
         data_at Tsh t_struct_hmac256drbg_context_st Ctx ctx;
         preseed_relate dp rc pr_flag ri Ctx;
         data_at Tsh t_struct_mbedtls_md_info Info info;
         da_emp Tsh (tarray tuchar (Zlength Data)) (map Vint (map Int.repr Data)) data;
         K_vector kv; Stream s)
    POST [ tint ]
       EX ret_value:_,
       PROP ()
       LOCAL (temp ret_temp (Vint ret_value))
       SEP (data_at Tsh t_struct_mbedtls_md_info Info info;
            da_emp Tsh (tarray tuchar (Zlength Data)) (map Vint (map Int.repr Data)) data;
            K_vector kv;
            if Int.eq ret_value (Int.repr (-20864))
            then data_at Tsh t_struct_hmac256drbg_context_st Ctx ctx *
                 preseed_relate dp rc pr_flag ri Ctx * Stream s
            else md_empty (fst Ctx) *
                 EX p:val, malloc_token Tsh (sizeof (Tstruct _hmac_ctx_st noattr)) p *
                 match (fst Ctx, fst handle_ss) with ((M1, (M2, M3)), ((((newV, newK), newRC), newEL), newPR))
                   => let CtxFinal := ((info, (M2, p)), (map Vint (map Int.repr newV), (Vint (Int.repr newRC), (Vint (Int.repr 32), (Val.of_bool newPR, Vint (Int.repr 10000)))))) in
                      !!(ret_value = Int.zero)
                      && data_at Tsh t_struct_hmac256drbg_context_st CtxFinal ctx *
                         hmac256drbg_relate (HMAC256DRBGabs newK newV newRC 32 newPR 10000) CtxFinal *
                         Stream (snd handle_ss)
                end).

Lemma body_hmac_drbg_seed_simple: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs
      f_mbedtls_hmac_drbg_seed hmac_drbg_seed_simple_spec.
Proof.
  start_function.
  abbreviate_semax.
  destruct H as [HDlen1 [HDlen2 [HData RES]]]. destruct handle_ss as [handle ss]. simpl in RES.
  rewrite data_at_isptr with (p:=ctx). Intros.
  destruct ctx; try contradiction.
  unfold_data_at 1%nat.
  destruct Ctx as [MdCTX [V [RC [EL [PR RI]]]]]. simpl.
  destruct MdCTX as [M1 [M2 M3]].
  freeze [1;2;3;4;5] FIELDS.
  rewrite field_at_compatible'. Intros. rename H into FC_mdx.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial. rewrite ptrofs_add_repr_0_r.
  freeze [0;2;3;4;5;6] FR0.
  Time forward_call ((M1,(M2,M3)), Vptr b i, Vint (Int.repr 1), info).

  Intros v. rename H into Hv.
  freeze [0] FR1. forward. thaw FR1.
  forward_if (
     PROP (v=0)
   LOCAL (temp _ret (Vint (Int.repr v)); temp _t'2 (Vint (Int.repr v));
   temp _ctx (Vptr b i); temp _md_info info; temp _len (Vint (Int.repr len));
   temp _custom data; gvar sha._K256 kv)
   SEP ( (EX p : val, !!malloc_compatible (sizeof (Tstruct _hmac_ctx_st noattr)) p &&
          memory_block Tsh (sizeof (Tstruct _hmac_ctx_st noattr)) p *
          malloc_token Tsh (sizeof (Tstruct _hmac_ctx_st noattr)) p *
          data_at Tsh (Tstruct _mbedtls_md_context_t noattr) (info,(M2,p)) (Vptr b i));
         FRZL FR0)).
  { destruct Hv; try omega. rewrite if_false; trivial. clear H. subst v.
    forward. simpl. Exists (Int.repr (-20864)).
    rewrite Int.eq_true.
    entailer!. thaw FR0. cancel.
    unfold_data_at 2%nat. thaw FIELDS. cancel.
    rewrite field_at_data_at. simpl.
    unfold field_address. rewrite if_true; simpl; trivial. rewrite ptrofs_add_repr_0_r; trivial. }
  { subst v. clear Hv. simpl. forward. entailer!. }
  Intros. subst v. clear Hv. Intros p. rename H into MCp. simpl in MCp.

  (*Alloction / md_setup succeeded. Now get md_size*)
  deadvars!. (*
  drop_LOCAL 0%nat.
  drop_LOCAL 0%nat.*)
  forward_call tt.

  (*call mbedtls_md_hmac_starts( &ctx->md_ctx, ctx->V, md_size )*)
  thaw FR0. subst.
  assert (ZL_VV: Zlength initial_key =32) by reflexivity.
  thaw FIELDS.
  freeze [4;5;6;7] FIELDS1.
  rewrite field_at_compatible'. Intros. rename H into FC_V.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial.
  rewrite <- ZL_VV.
  freeze [0;2;5;6;7;9] FR2.
  replace_SEP 1 (UNDER_SPEC.EMPTY p).
  { entailer!.
    eapply derives_trans. 2: apply UNDER_SPEC.mkEmpty.
    rewrite data_at__memory_block. simpl. entailer!.
  }
  forward_call (Vptr b i, ((info,(M2,p)):mdstate), 32, initial_key, kv, b, Ptrofs.add i (Ptrofs.repr 12)).
  { simpl. cancel. }
  { split; trivial. red. simpl. rewrite int_max_signed_eq.
    split. trivial. split. omega. rewrite two_power_pos_equiv.
    replace (2^64) with 18446744073709551616. omega. reflexivity.
    apply isbyteZ_initialKey.
  }
  Intros. clear H.

  (*call  memset( ctx->V, 0x01, md_size )*)
  freeze [0;1;3;4] FR3.
  forward_call (Tsh, Vptr b (Ptrofs.add i (Ptrofs.repr 12)), 32, Int.one).
  { rewrite sepcon_comm. apply sepcon_derives.
     - apply data_at_memory_block.
     - cancel. }

  (*ctx->reseed_interval = MBEDTLS_HMAC_DRBG_RESEED_INTERVAL;*)
  rewrite ZL_VV.
  thaw FR3. thaw FR2. unfold md_relate. simpl.
  replace_SEP 2 (field_at Tsh t_struct_hmac256drbg_context_st [StructField _md_ctx] (info, (M2, p)) (Vptr b i)). {
    entailer!. rewrite field_at_data_at.
    simpl. rewrite field_compatible_field_address by auto with field_compatible. simpl.
    rewrite ptrofs_add_repr_0_r.
    cancel.
  }
  thaw FIELDS1. forward.
  freeze [0;4;5;6;7] FIELDS2.
  freeze [0;1;2;3;4;5;6;7;8;9] ALLSEP.

  forward_if
  (PROP ( )
   LOCAL (temp _md_size (Vint (Int.repr 32)); temp _ctx (Vptr b i); temp _md_info info;
   temp _len (Vint (Int.repr (Zlength Data))); temp _custom data; gvar sha._K256 kv;
   temp _t'4 (Vint (Int.repr 32)))
   SEP (FRZL ALLSEP)).
  { elim H; trivial. }
  { clear H.
    forward_if.
    + elim H; trivial.
    + clear H. forward. forward. entailer!. }
  forward. simpl. deadvars!. (*drop_LOCAL 7%nat. _t'4*)

  (*NEXT INSTRUCTION:  ctx->entropy_len = entropy_len * 3 / 2*)
  thaw ALLSEP. thaw FIELDS2. forward.

  assert (FOURTYEIGHT: Int.unsigned (Int.mul (Int.repr 32) (Int.repr 3)) / 2 = 48).
  { rewrite mul_repr. simpl.
    rewrite Int.unsigned_repr. reflexivity. rewrite int_max_unsigned_eq; omega. }
  set (myABS := HMAC256DRBGabs initial_key initial_value rc 48 pr_flag 10000) in *.
  assert (myST: exists ST:hmac256drbgstate, ST =
    ((info, (M2, p)), (map Vint (list_repeat 32 Int.one), (Vint (Int.repr rc),
        (Vint (Int.repr 48), (Val.of_bool pr_flag, Vint (Int.repr 10000))))))). eexists; reflexivity.
  destruct myST as [ST HST].

  freeze [0;1;2;3;4] FR_CTX.
  freeze [3;4;6;7;8] KVStreamInfoDataFreeBlk.

  (*NEXT INSTRUCTION: mbedtls_hmac_drbg_reseed( ctx, custom, len ) *)
  freeze [1;2;3] INI.
  specialize (Forall_list_repeat isbyteZ 32 1); intros IB1.
  replace_SEP 0 (
         data_at Tsh t_struct_hmac256drbg_context_st ST (Vptr b i) *
         hmac256drbg_relate myABS ST).
  { entailer!. thaw INI. clear - FC_V IB1. (*KVStreamInfoDataFreeBlk.*) thaw FR_CTX.
    apply andp_right. apply prop_right. repeat split; trivial. apply IB1. split; omega.
    unfold_data_at 2%nat.
    cancel. unfold md_full; simpl.
    rewrite field_at_data_at; simpl.
    unfold field_address. rewrite if_true; simpl; trivial.
    cancel.
    apply UNDER_SPEC.REP_FULL.
  }

  clear INI.
  thaw KVStreamInfoDataFreeBlk. freeze [3;7] OLD_MD.
  forward_call (Data, data, Zlength Data, Vptr b i, ST, myABS, kv, Info, s).
  { unfold hmac256drbgstate_md_info_pointer.
    subst ST; simpl. cancel.
  }
  { subst myABS; simpl. rewrite <- initialize.max_unsigned_modulus in *; rewrite ptrofs_max_unsigned_eq.
    split. omega. (* rewrite int_max_unsigned_eq; omega.*)
    split. reflexivity.
    split. reflexivity.
    split. omega.
    split. (*change Int.modulus with 4294967296.*) omega.
    split. (* change Int.modulus with 4294967296.*)
       unfold contents_with_add. if_tac. omega. rewrite Zlength_nil; omega.
    split. apply IB1. split; omega.
    assumption.
  }

  Intros v.
  assert (ZLc': Zlength (contents_with_add data (Zlength Data) Data) = 0 \/
                 Zlength (contents_with_add data (Zlength Data) Data) = Zlength Data).
         { unfold contents_with_add. if_tac. right; trivial. left; trivial. }
  forward.
  deadvars!.
  forward_if (
   PROP ( v = nullval)
   LOCAL (temp _ret v; temp _t'7 v;
   temp _entropy_len (Vint (Int.repr 32));
   temp _ctx (Vptr b i); gvar sha._K256 kv)
   SEP (reseedPOST v Data data (Zlength Data) s
          myABS (Vptr b i) Info kv ST; FRZL OLD_MD)).
  { rename H into Hv. forward. simpl. Exists v.
    apply andp_right. apply prop_right; split; trivial.
    unfold reseedPOST.

    remember ((zlt 256 (Zlength Data) || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data)) %bool) as d.
    unfold myABS in Heqd; simpl in Heqd.
    destruct (zlt 256 (Zlength Data)); simpl in Heqd.
    + omega.
    + destruct (zlt 384 (48 + Zlength Data)); simpl in Heqd; try omega.
      subst d.
      unfold hmac256drbgstate_md_info_pointer, hmac256drbg_relate; simpl. Intros.
      rename H into RV.
      remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
         (contents_with_add data (Zlength Data) Data)) as MRS.
      rewrite (ReseedRes _ _ _ RV). cancel.
      unfold return_value_relate_result in RV.
      assert (ZLc'256F: Zlength (contents_with_add data (Zlength Data) Data) >? 256 = false).
      { apply Zgt_is_gt_bool_f. destruct ZLc' as [ZLc' | ZLc']; rewrite ZLc'; trivial. omega. }
      unfold hmac256drbgabs_common_mpreds, hmac256drbgstate_md_info_pointer.
      destruct MRS.
      - exfalso. inv RV. simpl in Hv. discriminate.
      - simpl. Intros. Exists p. thaw OLD_MD. cancel.
        subst myABS. rewrite <- instantiate_reseed in HeqMRS; trivial.
        rewrite RES in HeqMRS. inv HeqMRS.
  }
  { rename H into Hv. forward. entailer!.
    apply negb_false_iff in Hv.
    symmetry in Hv; apply binop_lemmas2.int_eq_true in Hv; subst v. trivial.
  }
  deadvars!. Intros. subst v.
  unfold reseedPOST.
  remember ((zlt 256 (Zlength Data)
          || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data))%bool) as d.
  destruct d; Intros.
  remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
         (contents_with_add data (Zlength Data) Data)) as MRS.
  unfold hmac256drbgabs_reseed. rewrite <- HeqMRS. subst myABS; simpl.

  assert (ZLc'256F: Zlength (contents_with_add data (Zlength Data) Data) >? 256 = false).
      { destruct ZLc' as [HH | HH]; rewrite HH. reflexivity.
        apply Zgt_is_gt_bool_f. omega. }
  rewrite <- instantiate_reseed, RES in HeqMRS; trivial. subst MRS. clear H RES Heqd.
  destruct handle as [[[[newV newK] newRC] dd] newPR].
  unfold hmac256drbgabs_common_mpreds. simpl. subst ST. unfold hmac256drbgstate_md_info_pointer. simpl. Intros.
  unfold_data_at 1%nat. freeze [0;1;2;4;5;6;7;8;9;10;11;12;13] ALLSEP.
  forward. forward.
  Exists Int.zero. simpl.
  apply andp_right. apply prop_right; split; trivial.
  thaw ALLSEP. thaw OLD_MD. Exists p.
  cancel;  normalize.
  apply andp_right. solve [apply prop_right; repeat split; trivial].
  cancel.
  unfold_data_at 1%nat. cancel.
  apply hmac_interp_empty.
Time Qed. (*Coq8.6: 26secs*)

(*Spec that does not assume len<=256 and includes a clause
  for the case where mbedtls_HMAC256_DRBG_instantiate_function yields
  Entropy.ERROR, ie no hypothesis about mbedtls_HMAC256_DRBG_instantiate_function in PROP of PRE*)
Definition hmac_drbg_seed_full_spec :=
  DECLARE _mbedtls_hmac_drbg_seed
   WITH dp:_, ctx: val, info:val, len: Z, data:val, Data: list Z,
        Ctx: hmac256drbgstate,
        kv: val, Info: md_info_state, s:ENTROPY.stream, rc:Z, pr_flag:bool, ri:Z
    PRE [_ctx OF tptr (Tstruct _mbedtls_hmac_drbg_context noattr),
         _md_info OF tptr (Tstruct _mbedtls_md_info_t noattr),
         _custom OF tptr tuchar, _len OF tuint ]
       PROP ( (len = Zlength Data) /\
              0 <= len /\
              48 + len < Int.modulus /\
              0 < 48 + Zlength (contents_with_add data len Data) < Int.modulus /\ Forall isbyteZ Data)
       LOCAL (temp _ctx ctx; temp _md_info info;
              temp _len (Vint (Int.repr len)); temp _custom data; gvar sha._K256 kv)
       SEP (
         data_at Tsh t_struct_hmac256drbg_context_st Ctx ctx;
         preseed_relate dp rc pr_flag ri Ctx;
         data_at Tsh t_struct_mbedtls_md_info Info info;
         da_emp Tsh (tarray tuchar (Zlength Data)) (map Vint (map Int.repr Data)) data;
         K_vector kv; Stream s)
    POST [ tint ]
       EX ret_value:_,
       PROP ()
       LOCAL (temp ret_temp (Vint ret_value))
       SEP (data_at Tsh t_struct_mbedtls_md_info Info info;
            da_emp Tsh (tarray tuchar (Zlength Data)) (map Vint (map Int.repr Data)) data;
            K_vector kv;
            if Int.eq ret_value (Int.repr (-20864))
            then data_at Tsh t_struct_hmac256drbg_context_st Ctx ctx *
                 preseed_relate dp rc pr_flag ri Ctx * Stream s
            else md_empty (fst Ctx) *
                 EX p:val, malloc_token Tsh (sizeof (Tstruct _hmac_ctx_st noattr)) p *
                 match (fst Ctx) with (M1, (M2, M3)) =>
                   if (zlt 256 (Zlength Data) || (zlt 384 (48 + Zlength Data)))%bool
                   then !!(ret_value = Int.repr (-5)) &&
                     (Stream s *
                     ( let CtxFinal:= ((info, (M2, p)), (list_repeat 32 (Vint Int.one), (Vint (Int.repr rc),
                                       (Vint (Int.repr 48), (Val.of_bool pr_flag, Vint (Int.repr 10000)))))) in
                       let CTXFinal:= HMAC256DRBGabs initial_key initial_value rc 48 pr_flag 10000 in
                       data_at Tsh t_struct_hmac256drbg_context_st CtxFinal ctx *
                                     hmac256drbg_relate CTXFinal CtxFinal))

                   else match mbedtls_HMAC256_DRBG_instantiate_function s entlen pr_flag
                                       (contents_with_add data (Zlength Data) Data)
                        with
                         | ENTROPY.error e ss =>
                            (!!(match e with
                               | ENTROPY.generic_error => Vint ret_value = Vint (Int.repr ENT_GenErr)
                               | ENTROPY.catastrophic_error => Vint ret_value = Vint (Int.repr (-9))
                              end) && (Stream ss *
                                       let CtxFinal:= ((info, (M2, p)), (list_repeat 32 (Vint Int.one), (Vint (Int.repr rc),
                                                (Vint (Int.repr 48), (Val.of_bool pr_flag, Vint (Int.repr 10000)))))) in
                                       let CTXFinal:= HMAC256DRBGabs initial_key initial_value rc 48 pr_flag 10000 in
                                       data_at Tsh t_struct_hmac256drbg_context_st CtxFinal ctx *
                                       hmac256drbg_relate CTXFinal CtxFinal))
                        | ENTROPY.success handle ss => !!(ret_value = Int.zero) &&
                                    match handle with ((((newV, newK), newRC), newEL), newPR) =>
                                      let CtxFinal := ((info, (M2, p)), (map Vint (map Int.repr newV), (Vint (Int.repr newRC), (Vint (Int.repr 32), (Val.of_bool newPR, Vint (Int.repr 10000)))))) in
                                      let CTXFinal := HMAC256DRBGabs newK newV newRC 32 newPR 10000 in
                                    data_at Tsh t_struct_hmac256drbg_context_st CtxFinal ctx *
                                    hmac256drbg_relate CTXFinal CtxFinal *
                                    Stream ss end
                        end
                end).

Lemma body_hmac_drbg_seed_full: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs
      f_mbedtls_hmac_drbg_seed hmac_drbg_seed_full_spec.
Proof.
  start_function.
  abbreviate_semax.
  destruct H as (*[PREQ*) [HDlen1 [HDlen2 [DHlen3 [DHlen4 HData]]]](*]*).
  rewrite data_at_isptr with (p:=ctx). Intros.
  destruct ctx; try contradiction.
  unfold_data_at 1%nat.
  destruct Ctx as [MdCTX [V [RC [EL [PR RI]]]]]. simpl.
  destruct MdCTX as [M1 [M2 M3]].
  freeze [1;2;3;4;5] FIELDS.
  rewrite field_at_compatible'. Intros. rename H into FC_mdx.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial. rewrite ptrofs_add_repr_0_r.
  freeze [0;2;3;4;5;6] FR0.
  Time forward_call ((M1,(M2,M3)), Vptr b i, Vint (Int.repr 1), info).

  Intros v. rename H into Hv.
  freeze [0] FR1. forward. thaw FR1.
  deadvars!.
  forward_if (
     PROP (v=0)
   LOCAL (temp _ret (Vint (Int.repr v)); temp _t'2 (Vint (Int.repr v));
   temp _ctx (Vptr b i); temp _md_info info; temp _len (Vint (Int.repr len));
   temp _custom data; gvar sha._K256 kv)
   SEP ( (EX p : val, !!malloc_compatible (sizeof (Tstruct _hmac_ctx_st noattr)) p &&
          memory_block Tsh (sizeof (Tstruct _hmac_ctx_st noattr)) p *
          malloc_token Tsh (sizeof (Tstruct _hmac_ctx_st noattr)) p *
          data_at Tsh (Tstruct _mbedtls_md_context_t noattr) (info,(M2,p)) (Vptr b i));
         FRZL FR0)).
  { destruct Hv; try omega. rewrite if_false; trivial. clear H. subst v.
    forward. simpl. Exists (Int.repr (-20864)).
    rewrite Int.eq_true.
    entailer!. thaw FR0. cancel.
    unfold_data_at 2%nat. thaw FIELDS. cancel.
    rewrite field_at_data_at. simpl.
    unfold field_address. rewrite if_true; simpl; trivial. rewrite ptrofs_add_repr_0_r; trivial. }
  { subst v. clear Hv. simpl. forward. entailer!. }
  Intros. subst v. clear Hv. Intros p. rename H into MCp. simpl in MCp.

  (*Alloction / md_setup succeeded. Now get md_size*)
  deadvars!.
  forward_call tt.

  (*call mbedtls_md_hmac_starts( &ctx->md_ctx, ctx->V, md_size )*)
  thaw FR0. subst.
  assert (ZL_VV: Zlength initial_key =32) by reflexivity.
  thaw FIELDS.
  freeze [4;5;6;7] FIELDS1.
  rewrite field_at_compatible'. Intros. rename H into FC_V.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial.
  rewrite <- ZL_VV.
  freeze [0;2;5;6;7;9] FR2.
  replace_SEP 1 (UNDER_SPEC.EMPTY p).
  { entailer!.
    eapply derives_trans. 2: apply UNDER_SPEC.mkEmpty.
    rewrite data_at__memory_block. simpl. entailer!.
  }
  forward_call (Vptr b i, ((info,(M2,p)):mdstate), 32, initial_key, kv, b, Ptrofs.add i (Ptrofs.repr 12)).
  { simpl. cancel. }
  { split; trivial. red. simpl. rewrite int_max_signed_eq.
    split. trivial. split. omega. rewrite two_power_pos_equiv.
    replace (2^64) with 18446744073709551616. omega. reflexivity.
    apply isbyteZ_initialKey.
  }
  Intros. clear H.

  (*call  memset( ctx->V, 0x01, md_size )*)
  freeze [0;1;3;4] FR3.
  forward_call (Tsh, Vptr b (Ptrofs.add i (Ptrofs.repr 12)), 32, Int.one).
  { rewrite sepcon_comm. apply sepcon_derives.
     - apply data_at_memory_block.
     - cancel. }

  (*ctx->reseed_interval = MBEDTLS_HMAC_DRBG_RESEED_INTERVAL;*)
  rewrite ZL_VV.
  thaw FR3. thaw FR2. unfold md_relate. simpl.
  replace_SEP 2 (field_at Tsh t_struct_hmac256drbg_context_st [StructField _md_ctx] (info, (M2, p)) (Vptr b i)). {
    entailer!. rewrite field_at_data_at.
    simpl. rewrite field_compatible_field_address by auto with field_compatible. simpl.
    rewrite ptrofs_add_repr_0_r.
    cancel.
  }
  deadvars!.
  thaw FIELDS1. forward.
  freeze [0;4;5;6;7] FIELDS2.
  freeze [0;1;2;3;4;5;6;7;8;9] ALLSEP.

  forward_if
  (PROP ( )
   LOCAL (temp _md_size (Vint (Int.repr 32)); temp _ctx (Vptr b i);
   temp _len (Vint (Int.repr (Zlength Data))); temp _custom data; gvar sha._K256 kv;
   temp _t'4 (Vint (Int.repr 32)))
   SEP (FRZL ALLSEP)).
  { elim H; trivial. }
  { clear H.
    forward_if.
    + elim H; trivial.
    + clear H. forward. forward. entailer!. }
  forward. simpl. deadvars!. (*drop_LOCAL 7%nat. _t'4*)

  (*NEXT INSTRUCTION:  ctx->entropy_len = entropy_len * 3 / 2*)
  thaw ALLSEP. thaw FIELDS2. forward.

  assert (FOURTYEIGHT: Int.unsigned (Int.mul (Int.repr 32) (Int.repr 3)) / 2 = 48).
  { rewrite mul_repr. simpl.
    rewrite Int.unsigned_repr. reflexivity. rewrite int_max_unsigned_eq; omega. }
  set (myABS := HMAC256DRBGabs initial_key initial_value rc 48 pr_flag 10000) in *.
  assert (myST: exists ST:hmac256drbgstate, ST =
    ((info, (M2, p)), (map Vint (list_repeat 32 Int.one), (Vint (Int.repr rc),
        (Vint (Int.repr 48), (Val.of_bool pr_flag, Vint (Int.repr 10000))))))). eexists; reflexivity.
  destruct myST as [ST HST].

  freeze [0;1;2;3;4] FR_CTX.
  freeze [3;4;6;7;8] KVStreamInfoDataFreeBlk.

  (*NEXT INSTRUCTION: mbedtls_hmac_drbg_reseed( ctx, custom, len ) *)
  freeze [1;2;3] INI.
  specialize (Forall_list_repeat isbyteZ 32 1); intros IB1.
  replace_SEP 0 (
         data_at Tsh t_struct_hmac256drbg_context_st ST (Vptr b i) *
         hmac256drbg_relate myABS ST).
  { entailer!. thaw INI. clear - FC_V IB1. (*KVStreamInfoDataFreeBlk.*) thaw FR_CTX.
    apply andp_right. apply prop_right. repeat split; trivial. apply IB1. split; omega.
    unfold_data_at 2%nat.
    cancel. unfold md_full; simpl.
    rewrite field_at_data_at; simpl.
    unfold field_address. rewrite if_true; simpl; trivial.
    cancel.
    apply UNDER_SPEC.REP_FULL.
  }

  clear INI.
  thaw KVStreamInfoDataFreeBlk. freeze [3;7] OLD_MD.
  forward_call (Data, data, Zlength Data, Vptr b i, ST, myABS, kv, Info, s).
  { unfold hmac256drbgstate_md_info_pointer.
    subst ST; simpl. cancel.
  }
  { subst myABS; simpl. rewrite <- initialize.max_unsigned_modulus in *.
    split. rep_omega. (* rewrite int_max_unsigned_eq; omega.*)
    split. reflexivity.
    split. reflexivity.
    split. omega.
    split. rep_omega.
    split. (* change Int.modulus with 4294967296.*)
       unfold contents_with_add. if_tac. rep_omega. rewrite Zlength_nil; rep_omega.
    split. apply IB1. split; omega.
    assumption.
  }

  Intros v.
  assert (ZLc': Zlength (contents_with_add data (Zlength Data) Data) = 0 \/
                 Zlength (contents_with_add data (Zlength Data) Data) = Zlength Data).
         { unfold contents_with_add. if_tac. right; trivial. left; trivial. }
  forward.
  deadvars!.
  forward_if (
   PROP ( v = nullval)
   LOCAL (temp _ret v; temp _t'7 v;
   temp _entropy_len (Vint (Int.repr 32)); temp _ctx (Vptr b i); gvar sha._K256 kv)
   SEP (reseedPOST v Data data (Zlength Data) s
          myABS (Vptr b i) Info kv ST; FRZL OLD_MD)).
  { rename H into Hv. forward. simpl. Exists v.
    apply andp_right. apply prop_right; split; trivial.
    unfold reseedPOST.

    remember ((zlt 256 (Zlength Data) || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data)) %bool) as d.
    unfold myABS in Heqd; simpl in Heqd.
    destruct (zlt 256 (Zlength Data)); simpl in Heqd.
    + subst d. unfold hmac256drbgstate_md_info_pointer, hmac256drbg_relate; simpl.
      simpl. subst myABS. normalize. cancel. simpl.
      Exists p. thaw OLD_MD. normalize.
      apply andp_right. apply prop_right; repeat split; trivial. cancel.
      apply hmac_interp_empty.
    + destruct (zlt 384 (48 + Zlength Data)); simpl in Heqd; try omega.
      subst d.
      unfold hmac256drbgstate_md_info_pointer, hmac256drbg_relate; simpl. Intros.
      rename H into RV.
      remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
         (contents_with_add data (Zlength Data) Data)) as MRS.
      rewrite (ReseedRes _ _ _ RV). cancel.
      unfold return_value_relate_result in RV.
      assert (ZLc'256F: Zlength (contents_with_add data (Zlength Data) Data) >? 256 = false).
      { apply Zgt_is_gt_bool_f. destruct ZLc' as [ZLc' | ZLc']; rewrite ZLc'; trivial. omega. }
      unfold hmac256drbgabs_common_mpreds, hmac256drbgstate_md_info_pointer.
      destruct MRS.
      - exfalso. inv RV. simpl in Hv. discriminate.
      - simpl. Intros. Exists p. thaw OLD_MD. cancel.
        subst myABS. rewrite <- instantiate_reseed in HeqMRS; trivial.
        rewrite <- HeqMRS.
        normalize.
        apply andp_right. apply prop_right; repeat split; trivial.
        cancel. apply hmac_interp_empty.
  }
  { rename H into Hv. forward. entailer!.
    apply negb_false_iff in Hv.
    symmetry in Hv; apply binop_lemmas2.int_eq_true in Hv; subst v. trivial.
  }
  deadvars!. Intros. subst v.
  unfold reseedPOST.
  remember ((zlt 256 (Zlength Data)
          || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data))%bool) as d.
  destruct d; Intros.
  remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
         (contents_with_add data (Zlength Data) Data)) as MRS.
  unfold hmac256drbgabs_reseed. rewrite <- HeqMRS. subst myABS; simpl.
  unfold return_value_relate_result in H.
  destruct MRS. Focus 2. exfalso. destruct e. inv H.
                     destruct ENT_GenErrAx as [EL1 _]. rewrite <- H in EL1. elim EL1; trivial.
  clear H.
  destruct d as [[[[newV newK] newRC] dd] newPR].
  unfold hmac256drbgabs_common_mpreds. simpl. subst ST. unfold hmac256drbgstate_md_info_pointer. simpl. Intros.
  unfold_data_at 1%nat. freeze [0;1;2;4;5;6;7;8;9;10;11;12] ALLSEP.
  forward. forward.
  Exists Int.zero. simpl.
  apply andp_right. apply prop_right; split; trivial.
  symmetry in Heqd. apply orb_false_iff in Heqd. destruct Heqd as [Heqd1 Heqd2].
  destruct (zlt 256 (Zlength Data)); try discriminate. simpl in *. rewrite Heqd2.
  thaw ALLSEP. thaw OLD_MD. Exists p. cancel.
  normalize.
  assert (ZLc'256F: Zlength (contents_with_add data (Zlength Data) Data) >? 256 = false).
      { destruct ZLc' as [HH | HH]; rewrite HH. reflexivity.
        apply Zgt_is_gt_bool_f. omega. }
  rewrite <- instantiate_reseed in HeqMRS; trivial.
  rewrite <- HeqMRS.
  normalize.
  apply andp_right. apply prop_right; repeat split; trivial.
  cancel.
  unfold_data_at 1%nat. cancel.
  apply hmac_interp_empty.
Time Qed. (*Coq8.6: 32secs*)
   (*Feb 22nd 2017: 245.406 secs (233.843u,0.203s) (successful)*)
   (*earlier: 69.671 secs (59.578u,0.015s) (successful)*)

End Instantiate_eq.

Lemma ReseedRes: forall X r v, @return_value_relate_result X r (Vint v) -> Int.eq v (Int.repr (-20864)) = false.
Proof. intros.
  unfold return_value_relate_result in H.
  destruct r. inv H; reflexivity.
  destruct e; inv H; try reflexivity.
  apply Int.eq_false. eapply ENT_GenErrAx.
Qed.

Definition preseed_relate V rc pr ri (r : hmac256drbgstate):mpred:=
    match r with
     (md_ctx', (V', (reseed_counter', (entropy_len', (prediction_resistance', reseed_interval'))))) =>
    md_empty md_ctx' &&
    !! (map Vint (map Int.repr V) = V' /\
        Zlength V = 32 /\
        Forall isbyteZ V /\
        Vint (Int.repr rc) = reseed_counter'(* /\
        Vint (Int.repr entropy_len) = entropy_len'*) /\
        Vint (Int.repr ri) = reseed_interval' /\
        Val.of_bool pr = prediction_resistance')
   end.

Definition hmac_drbg_seed_spec :=
  DECLARE _mbedtls_hmac_drbg_seed
   WITH ctx: val, info:val, len: Z, data:val, Data: list Z,
        Ctx: hmac256drbgstate,
        (*CTX: hmac256drbgabs,*)
        kv: val, Info: md_info_state, s:ENTROPY.stream, rc:Z, pr:bool, ri:Z, VV:list Z
    PRE [_ctx OF tptr (Tstruct _mbedtls_hmac_drbg_context noattr),
         _md_info OF tptr (Tstruct _mbedtls_md_info_t noattr),
         _custom OF tptr tuchar, _len OF tuint ]
       PROP ( (len = Zlength Data) /\
              0 <= len (*<= 336 Int.max_unsigned*) /\
              48 + len < Int.modulus /\
              0 < 48 + Zlength (contents_with_add data len Data) < Int.modulus /\ Forall isbyteZ Data)
       LOCAL (temp _ctx ctx; temp _md_info info;
              temp _len (Vint (Int.repr len)); temp _custom data; gvar sha._K256 kv)
       SEP (
         data_at Tsh t_struct_hmac256drbg_context_st Ctx ctx;
         preseed_relate VV rc pr ri Ctx;
         (*hmac256drbg_relate CTX Ctx;*)
         data_at Tsh t_struct_mbedtls_md_info Info info;
         da_emp Tsh (tarray tuchar (Zlength Data)) (map Vint (map Int.repr Data)) data;
         K_vector kv; Stream s)
    POST [ tint ]
       EX ret_value:_,
       PROP ()
       LOCAL (temp ret_temp (Vint ret_value))
       SEP (data_at Tsh t_struct_mbedtls_md_info Info info;
            da_emp Tsh (tarray tuchar (Zlength Data)) (map Vint (map Int.repr Data)) data;
            K_vector kv;
            if Int.eq ret_value (Int.repr (-20864))
            then data_at Tsh t_struct_hmac256drbg_context_st Ctx ctx *
                  (*hmac256drbg_relate CTX Ctx *) preseed_relate VV rc pr ri Ctx *
                  Stream s
            else md_empty (fst Ctx) *
                 EX p:val, malloc_token Tsh (sizeof (Tstruct _hmac_ctx_st noattr)) p *
                 match (fst Ctx) with (M1, (M2, M3)) =>
                   if (zlt 256 (Zlength Data) || (zlt 384 ((*hmac256drbgabs_entropy_len initial_state_abs*)48 + Zlength Data)))%bool
                   then !!(ret_value = Int.repr (-5)) &&
                     (Stream s *
                     ( let CtxFinal:= ((info, (M2, p)), (list_repeat 32 (Vint Int.one), (Vint (Int.repr rc),
                                       (Vint (Int.repr 48), (Val.of_bool pr, Vint (Int.repr 10000)))))) in
                       let CTXFinal:= HMAC256DRBGabs VV (list_repeat 32 1) rc 48 pr 10000 in
                       data_at Tsh t_struct_hmac256drbg_context_st CtxFinal ctx *
                                     hmac256drbg_relate CTXFinal CtxFinal))

                   else let myABS := HMAC256DRBGabs VV (list_repeat 32 1) rc 48 pr 10000
                      in match mbedtls_HMAC256_DRBG_reseed_function s myABS
                                (contents_with_add data (Zlength Data) Data)
                         with
                         | ENTROPY.error e ss =>
                            (!!(match e with
                               | ENTROPY.generic_error => Vint ret_value = Vint (Int.repr ENT_GenErr)
                               | ENTROPY.catastrophic_error => Vint ret_value = Vint (Int.repr (-9))
                              end) && (Stream ss *
                                       let CtxFinal:= ((info, (M2, p)), (list_repeat 32 (Vint Int.one), (Vint (Int.repr rc),
                                                (Vint (Int.repr 48), (Val.of_bool pr, Vint (Int.repr 10000)))))) in
                                       let CTXFinal:= HMAC256DRBGabs VV (list_repeat 32 1) rc 48 pr 10000 in
                                       data_at Tsh t_struct_hmac256drbg_context_st CtxFinal ctx *
                                       hmac256drbg_relate CTXFinal CtxFinal))
                        | ENTROPY.success handle ss => !!(ret_value = Int.zero) &&
                                    match handle with ((((newV, newK), newRC), newEL), newPR) =>
                                      let CtxFinal := ((info, (M2, p)), (map Vint (map Int.repr newV), (Vint (Int.repr newRC), (Vint (Int.repr 32), (Val.of_bool newPR, Vint (Int.repr 10000)))))) in
                                      let CTXFinal := HMAC256DRBGabs newK newV newRC 32 newPR 10000 in
                                    data_at Tsh t_struct_hmac256drbg_context_st CtxFinal ctx *
                                    hmac256drbg_relate CTXFinal CtxFinal *
                                    Stream ss end
                        end
                end).

Opaque mbedtls_HMAC256_DRBG_reseed_function.

Lemma body_hmac_drbg_seed: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs
      f_mbedtls_hmac_drbg_seed hmac_drbg_seed_spec.
Proof.
  start_function.
  abbreviate_semax.
  destruct H as [HDlen1 [HDlen2 [DHlen3 [DHlen4 HData]]]].
  rewrite data_at_isptr with (p:=ctx). Intros.
  destruct ctx; try contradiction.
  unfold_data_at 1%nat.
  destruct Ctx as [MdCTX [V [RC [EL [PR RI]]]]]. simpl.
  destruct MdCTX as [M1 [M2 M3]].
  freeze [1;2;3;4;5] FIELDS.
  rewrite field_at_compatible'. Intros. rename H into FC_mdx.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial. rewrite ptrofs_add_repr_0_r.
  freeze [0;2;3;4;5;6] FR0.
  Time forward_call ((M1,(M2,M3)), Vptr b i, Vint (Int.repr 1), info).
  Intros v. rename H into Hv.
  freeze [0] FR1. forward. thaw FR1.

  forward_if (
     PROP (v=0)
   LOCAL (temp _ret (Vint (Int.repr v)); temp _t'2 (Vint (Int.repr v));
   temp _ctx (Vptr b i); temp _md_info info; temp _len (Vint (Int.repr len));
   temp _custom data; gvar sha._K256 kv)
   SEP ( (EX p : val, !!malloc_compatible (sizeof (Tstruct _hmac_ctx_st noattr))p &&
          memory_block Tsh (sizeof (Tstruct _hmac_ctx_st noattr)) p *
          malloc_token Tsh (sizeof (Tstruct _hmac_ctx_st noattr)) p *
          data_at Tsh (Tstruct _mbedtls_md_context_t noattr) (info,(M2,p)) (Vptr b i));
         FRZL FR0)).
  { destruct Hv; try omega. rewrite if_false; trivial. clear H. subst v.
    forward. simpl. Exists (Int.repr (-20864)).
    rewrite Int.eq_true.
    entailer!. thaw FR0. cancel.
    unfold_data_at 2%nat. thaw FIELDS. cancel.
    rewrite field_at_data_at. simpl.
    unfold field_address. rewrite if_true; simpl; trivial. rewrite ptrofs_add_repr_0_r; trivial. }
  { subst v. clear Hv. simpl. forward. entailer!. }
  Intros. subst v. clear Hv. Intros p. rename H into MCp.

  (*Alloction / md_setup succeeded. Now get md_size*)
  deadvars!.
  forward_call tt.

  (*call mbedtls_md_hmac_starts( &ctx->md_ctx, ctx->V, md_size )*)
  thaw FR0. subst.
  rename H1 into ZL_VV. rename H2 into isbyteZ_VV.
  thaw FIELDS.
  freeze [4;5;6;7] FIELDS1.
  rewrite field_at_compatible'. Intros. rename H into FC_V.
  rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial.
  rewrite <- ZL_VV.
  freeze [0;2;5;6;7;9] FR2.
  replace_SEP 1 (UNDER_SPEC.EMPTY p).
  { entailer!.
    eapply derives_trans. 2: apply UNDER_SPEC.mkEmpty.
    rewrite data_at__memory_block. simpl. entailer!.
  }
  forward_call (Vptr b i, ((info,(M2,p)):mdstate), 32, VV, kv, b, Ptrofs.add i (Ptrofs.repr 12)).
  { rewrite ZL_VV, ptrofs_add_repr_0_r; simpl.
    apply prop_right; repeat split; trivial.
  }
  { simpl. cancel. }
  { split; trivial. red. simpl. rewrite int_max_signed_eq, ZL_VV.
    split. trivial. split. omega. rewrite two_power_pos_equiv.
    change (2^64) with 18446744073709551616. omega.
  }
  Intros.

  (*call  memset( ctx->V, 0x01, md_size )*)
  freeze [0;1;3;4] FR3.
  forward_call (Tsh, Vptr b (Ptrofs.add i (Ptrofs.repr 12)), 32, Int.one).
  { rewrite ZL_VV; entailer!.
  }
  { rewrite sepcon_comm. apply sepcon_derives.
      eapply derives_trans. apply data_at_memory_block.
        rewrite ZL_VV. simpl. cancel. cancel. }
  (*{ split. apply semax_call.writable_share_top.
    rewrite ZL_V0, client_lemmas.int_max_unsigned_eq. omega. }*)

  (*ctx->reseed_interval = MBEDTLS_HMAC_DRBG_RESEED_INTERVAL;*)
  rewrite ZL_VV.
  thaw FR3. thaw FR2. unfold md_relate. simpl.
  replace_SEP 2 (field_at Tsh t_struct_hmac256drbg_context_st [StructField _md_ctx] (info, (M2, p)) (Vptr b i)). {
    entailer!. rewrite field_at_data_at.
    simpl. rewrite field_compatible_field_address by auto with field_compatible. simpl.
    rewrite ptrofs_add_repr_0_r.
    cancel.
  }
  thaw FIELDS1. forward.
  freeze [0;4;5;6;7] FIELDS2.
  freeze [0;1;2;3;4;5;6;7;8;9] ALLSEP.
(*  set (ent_len := new_ent_len (Zlength V0)) in *.*)

  forward_if
  (PROP ( )
   LOCAL (temp _md_size (Vint (Int.repr 32)); temp _ctx (Vptr b i); temp _md_info info;
   temp _len (Vint (Int.repr (Zlength Data))); temp _custom data; gvar sha._K256 kv;
   temp _t'4 (Vint (Int.repr 32)))
   SEP (FRZL ALLSEP)).
  { elim H; trivial. }
  { clear H.
    forward_if.
    { elim H; trivial. }
    { clear H. forward. forward. entailer!. }
  }
  forward. simpl. drop_LOCAL 7%nat. (*_t'4*)

  (*NEXT INSTRUCTION:  ctx->entropy_len = entropy_len * 3 / 2*)
  thaw ALLSEP. thaw FIELDS2. forward.

  assert (FOURTYEIGHT: Int.unsigned (Int.mul (Int.repr 32) (Int.repr 3)) / 2 = 48).
  { rewrite mul_repr. simpl.
    rewrite Int.unsigned_repr. reflexivity. rewrite int_max_unsigned_eq; omega. }

  set (myABS := HMAC256DRBGabs VV (list_repeat 32 1) rc 48 pr 10000) in *.
  assert (myST: exists ST:hmac256drbgstate, ST =
    ((info, (M2, p)), (map Vint (list_repeat 32 Int.one), (Vint (Int.repr rc),
        (Vint (Int.repr 48), (Val.of_bool pr, Vint (Int.repr 10000))))))). eexists; reflexivity.
  destruct myST as [ST HST].

  freeze [0;1;2;3;4] FR_CTX.
  freeze [3;4;6;7;8] KVStreamInfoDataFreeBlk.

  (*NEXT INSTRUCTION: mbedtls_hmac_drbg_reseed( ctx, custom, len ) *)
  freeze [1;2;3] INI.
  specialize (Forall_list_repeat isbyteZ 32 1); intros IB1.
  replace_SEP 0 (
         data_at Tsh t_struct_hmac256drbg_context_st ST (Vptr b i) *
         hmac256drbg_relate myABS ST).
  { go_lower. thaw INI. clear KVStreamInfoDataFreeBlk. thaw FR_CTX.
    unfold_data_at 2%nat.
    subst ST; simpl. cancel. normalize.
    apply andp_right. apply prop_right. repeat split; trivial. apply IB1. split; omega.
    unfold md_full. simpl.
    rewrite field_at_data_at. simpl.
    unfold field_address. rewrite if_true; simpl; trivial. cancel.
    apply UNDER_SPEC.REP_FULL.
  }

  clear INI.
  thaw KVStreamInfoDataFreeBlk. freeze [3;7] OLD_MD.
  forward_call (Data, data, Zlength Data, Vptr b i, ST, myABS, kv, Info, s).
  { unfold hmac256drbgstate_md_info_pointer.
    subst ST; simpl. cancel.
  }
  { subst myABS; simpl. rewrite <- initialize.max_unsigned_modulus in *.
    split. rep_omega. (* rewrite int_max_unsigned_eq; omega.*)
    split. reflexivity.
    split. reflexivity.
    split. omega.
    split. (*change Int.modulus with 4294967296.*) rep_omega.
    split. (* change Int.modulus with 4294967296.*)
       unfold contents_with_add. if_tac. rep_omega. rewrite Zlength_nil; rep_omega.
    split. apply IB1. split; omega.
    assumption.
  }

  Intros v.

  forward.
  forward_if (
   PROP ( v = nullval)
   LOCAL (temp _ret v; temp _t'7 v;
   temp _entropy_len (Vint (Int.repr 32));
   temp _md_size (Vint (Int.repr 32)); temp _ctx (Vptr b i);
   temp _md_info info;
   temp _len (Vint (Int.repr (Zlength Data)));
   temp _custom data; gvar sha._K256 kv)
   SEP (reseedPOST v Data data (Zlength Data) s
          myABS (Vptr b i) Info kv ST; FRZL OLD_MD)).
  { rename H into Hv. forward. simpl. Exists v.
    apply andp_right. apply prop_right; split; trivial.
    unfold reseedPOST.

    remember ((zlt 256 (Zlength Data) || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data)) %bool) as d.
    unfold myABS in Heqd; simpl in Heqd.
    destruct (zlt 256 (Zlength Data)); simpl in Heqd.
    + subst d. unfold hmac256drbgstate_md_info_pointer, hmac256drbg_relate; simpl.
      simpl. subst myABS. normalize. simpl. cancel.
      Exists p. thaw OLD_MD. normalize.
      apply andp_right. apply prop_right; repeat split; trivial. cancel.
    + destruct (zlt 384 (48 + Zlength Data)); simpl in Heqd; try omega.
      subst d.
      unfold hmac256drbgstate_md_info_pointer, hmac256drbg_relate; simpl. normalize.
      rename H into RV.
      remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
         (contents_with_add data (Zlength Data) Data)) as MRS.
      rewrite (ReseedRes _ _ _ RV). cancel.
      unfold return_value_relate_result in RV.
      destruct MRS.
      - exfalso. inv RV. simpl in Hv. discriminate.
      - unfold hmac256drbgabs_common_mpreds, hmac256drbgstate_md_info_pointer; simpl. normalize.
        Exists p. thaw OLD_MD. cancel. normalize.
        apply andp_right. apply prop_right; repeat split; trivial.
        cancel.
  }
  { rename H into Hv. forward.
    go_lower. simpl in Hv. apply typed_false_of_bool in Hv. apply negb_false_iff in Hv.
    symmetry in Hv; apply binop_lemmas2.int_eq_true in Hv. subst v.
    entailer!.
  }
  deadvars!. Intros. subst v.
  unfold reseedPOST.
  remember ((zlt 256 (Zlength Data)
          || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data))%bool) as d.
  destruct d; Intros.
  remember (mbedtls_HMAC256_DRBG_reseed_function s myABS
         (contents_with_add data (Zlength Data) Data)) as MRS.
  unfold return_value_relate_result in H.
  destruct MRS. Focus 2. exfalso. destruct e. inv H.
                     destruct ENT_GenErrAx as [EL1 _]. rewrite <- H in EL1. elim EL1; trivial.
  clear H. unfold hmac256drbgabs_reseed. rewrite <- HeqMRS. subst myABS; simpl.
  destruct d as [[[[newV newK] newRC] dd] newPR].
  unfold hmac256drbgabs_common_mpreds. simpl. subst ST. unfold hmac256drbgstate_md_info_pointer. simpl. Intros.
  unfold_data_at 1%nat. freeze [0;1;2;4;5;6;7;8;9;10;11] XX.
  forward. forward.
  Exists Int.zero. simpl. symmetry in Heqd. apply orb_false_iff in Heqd. destruct Heqd as [Heqd1 Heqd2].
  destruct (zlt 256 (Zlength Data)); try discriminate.
  apply andp_right. apply prop_right; split; trivial.
  thaw XX. thaw OLD_MD. cancel. simpl in *. rewrite Heqd2, <- HeqMRS.
  Exists p. normalize.
  apply andp_right. apply prop_right; repeat split; trivial.
  unfold_data_at 3%nat. cancel.
Time Qed. (*Coq8.6: 40secs*)
          (*Jan 22nd 2017: 267.171 secs (182.812u,0.015s) (successful)*)
          (*earlier: Finished transaction in 121.296 secs (70.921u,0.062s) (successful)*)