(***********************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
(*   \VV/  *************************************************************)
(*    //   *      This file is distributed under the terms of the      *)
(*         *       GNU Lesser General Public License Version 2.1       *)
(***********************************************************************)

(** * Finite sets library *)

(** This file proposes an implementation of the non-dependant
    interface [MSetWeakInterface.S] using lists without redundancy. *)

Require Import MMapInterface.
Set Implicit Arguments.
Unset Strict Implicit.

(** * Functions over lists

   First, we provide sets as lists which are (morally) without redundancy.
   The specs are proved under the additional condition of no redundancy.
   And the functions returning sets are proved to preserve this invariant. *)

(** ** The set operations. *)

Module Ops (X: DecidableType) <: WOps X.

  Definition key := X.t.

  Section Foo.
  Variable A : Type.

  Definition t  := list (key * A).

  Definition empty : t := nil.

  Definition is_empty (l : t) : bool := if l then true else false.

  Fixpoint mem (x : key) (s : t) : bool :=
    match s with
    | nil => false
    | (k, v) :: l =>
           if X.eq_dec x k then true else mem x l
    end.

  Fixpoint find (x : key) (s : t) : option A :=
    match s with
    | nil => None
    | (k, v) :: l =>
           if X.eq_dec x k then Some v else find x l
    end.

  Fixpoint add (x : key) (v : A) (s : t) : t :=
    match s with
    | nil => (x, v) :: nil
    | (y, v') :: l =>
        if X.eq_dec x y then (y, v) :: l else (y, v') :: add x v l
    end.

  Definition singleton (x : key) (v : A) : t := (x, v) :: nil.

  Fixpoint remove (x : key) (s : t) : t :=
    match s with
    | nil => nil
    | (y, v) :: l =>
        if X.eq_dec x y then l else (y, v) :: remove x l
    end.

  Definition fold (B : Type) (f : key -> A -> B -> B) (s : t) (i : B) : B :=
    fold_left (fun a p => f (fst p) (snd p) a) s i.

  (*
  Definition union (s : t) : t -> t := fold add s.

  Definition diff (s s' : t) : t := fold (fun k v => remove k) s' s.

  Definition inter (s s': t) : t :=
    fold (fun x k s => if mem x s' then add x k s else s) s nil.
   *)

  Fixpoint filter (f : key -> A -> bool) (s : t) : t :=
    match s with
    | nil => nil
    | (x, v) :: l => if f x v then (x, v) :: filter f l else filter f l
    end.

  Fixpoint for_all (f : key -> A -> bool) (s : t) : bool :=
    match s with
    | nil => true
    | (x, v) :: l => if f x v then for_all f l else false
    end.

  Section ElemEq.
  Variable eq : A -> A -> bool.

  Definition subset (s s' : t) : bool :=
    for_all (fun k v =>
               match find k s' with
               | Some v' => eq v v'
               | None => false end) s.

  Definition equal (s s' : t) : bool := andb (subset s s') (subset s' s).
  End ElemEq.

  Fixpoint exists_ (f : key -> A -> bool) (s : t) : bool :=
    match s with
    | nil => false
    | (x, v) :: l => if f x v then true else exists_ f l
    end.

  Fixpoint partition (f : key -> A -> bool) (s : t) : t * t :=
    match s with
    | nil => (nil, nil)
    | (x, v) :: l =>
        let (s1, s2) := partition f l in
        if f x v then ((x,v) :: s1, s2) else (s1, (x,v) :: s2)
    end.

  Definition cardinal (s : t) : nat := length s.

  Definition elements (s : t) : list (key * A) := s.

  Definition choose (s : t) : option (key * A) :=
     match s with
      | nil => None
      | x::_ => Some x
     end.
  End Foo.

  Definition mapi {A A'} (f : key -> A -> A') : t A -> t A' :=
    List.map (fun p => (fst p, f (fst p) (snd p))).

  Definition map {A A'} (f : A -> A') : t A -> t A' :=
    mapi (fun k v => f v).

  Definition map2 {A A' A''} (f : option A -> option A' -> option A'') : t A -> t A' ->  t A''.
  Admitted.

End Ops.

(** ** Proofs of set operation specifications. *)

Module MakeRaw (X:DecidableType) <: WRawMaps X.
  Include Ops X.

  Section ForNotations.
  Variable A : Type.

  Inductive MapsToA (x : key) (v : A) : t A -> Prop :=
  | MapsTo_cons_hd : forall k l, X.eq x k -> MapsToA x v ((k,v) :: l)
  | MapsTo_cons_tl : forall k v' l, MapsToA x v l -> MapsToA x v ((k,v') :: l).

  Lemma MapsTo_cons: forall x k v v' l,
    (MapsToA x v ((k,v') :: l) <-> (X.eq x k /\ v = v') \/ MapsToA x v l).
  Proof.
   intros. split; intro HM.
    * inversion HM.
     - left; split. assumption. reflexivity.
     - right; assumption.
    * inversion HM.
      - inversion H. rewrite H1. constructor. assumption.
      - constructor. assumption.
  Qed.

  Lemma MapsTo_other: forall x k v v' l,
    ~ X.eq x k -> (MapsToA x v ((k,v') :: l) <-> MapsToA x v l).
  Proof.
    intros. rewrite MapsTo_cons. intuition.
  Qed.

  Definition MapsTo := MapsToA.

  Definition In (k:key)(m: t A) : Prop := exists e:A, MapsTo k e m.

  Lemma In_cons: forall x k v l,
    (In x ((k,v) :: l) <-> (X.eq x k) \/ In x l).
  Proof.
    intros.
    unfold In.
    split; intro H; inversion H.
     * rewrite MapsTo_cons in H0. inversion H0. left. intuition. right. exists x0. assumption.
     * exists v. constructor. assumption.
     * inversion H0. exists x0. constructor. assumption.
  Qed.

  Lemma In_ind :
    forall (P : key -> t A -> Prop),
    (forall k k' v m, X.eq k k' -> P k ((k',v)::m)) ->
    (forall k k' v m, P  k m -> P k ((k',v)::m)) ->
    forall k m, (In k m -> P k m).
  Proof.
    intros.
    unfold In in H1.
    inversion_clear H1.
    induction H2.
    - apply H; assumption.
    - apply H0; assumption.
  Qed.

  Definition Empty m := forall k a, ~ MapsTo k a m.

  Definition eq_key (p p':key*A) := X.eq (fst p) (fst p').
  Definition eq_key_elt (p p':key*A) :=
          X.eq (fst p) (fst p') /\ (snd p) = (snd p').

  (* TODO: Copy explanation from FMap *)
  Definition Equal m m' := forall k, @find A k m = find k m'.
  Definition Equiv (eq_elt: A -> A -> Prop) m m' :=
         (forall k, In k m <-> In k m') /\
         (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e').
  Definition Equivb (cmp: A -> A -> bool) := Equiv (Cmp cmp).

  Definition For_all (P : key -> A -> Prop) m := forall k a, MapsTo k a m -> P k a.
  Definition Exists (P : key -> A -> Prop) m := exists k a, MapsTo k a m /\ P k a.

  Inductive NoDup : t A -> Prop :=
  | NoDup_nil : NoDup nil
  | NoDup_cons : forall x v l, ~ In x l -> NoDup l -> NoDup ((x,v)::l).

  (* TODO: modify proofs in order to avoid these hints *)
  Let eqr:= (@Equivalence_Reflexive _ _ X.eq_equiv).
  Let eqsym:= (@Equivalence_Symmetric _ _ X.eq_equiv).
  Let eqtrans:= (@Equivalence_Transitive _ _ X.eq_equiv).
  Hint Resolve eqr eqtrans.
  Hint Immediate eqsym.

  Definition IsOk := NoDup.

  Class Ok (s:t A) : Prop := ok : NoDup s.

  Hint Unfold Ok.
  Hint Resolve ok.

  Instance NoDup_Ok s (nd : NoDup s) : Ok s := { ok := nd }.

  Ltac inv_ok := match goal with
   | H:Ok (_ :: _) |- _ => inversion_clear H; inv_ok
   | H:Ok nil |- _ => clear H; inv_ok
   | H:NoDup ?l |- _ => change (Ok l) in H; inv_ok
   | _ => idtac
  end.

  Ltac inv := invlist InA; inv_ok.
  Ltac constructors := repeat constructor.

  Fixpoint isok l := match l with
   | nil => true
   | (x,v)::l => negb (@mem A x l) && isok l
  end.

  Instance MapsTo_compat : Proper (X.eq==>eq==>eq==>iff) MapsTo.
  Proof.
    repeat red; intros. subst. unfold MapsTo.
    split.
    * intro H1. induction H1.
      - constructor. transitivity x. symmetry. assumption. assumption.
      - constructor. assumption.
    * intro H1. induction H1. constructor.
      - transitivity y. assumption. assumption.
      - constructor. assumption.
  Qed.
  Hint Resolve MapsTo_compat.

  Instance In_compat : Proper (X.eq==>eq==>iff) In.
  Proof. unfold In.  solve_proper. Qed.
  Hint Resolve In_compat.

  Lemma unique: forall s k v v' `{Ok s}, MapsTo k v s -> MapsTo k v' s -> v = v'.
  Proof.
    intros.
    induction H0; inversion H1; subst; clear H1;
                  inversion H; subst; clear H.
    - reflexivity.
    - exfalso. apply H4. exists v'. rewrite <- H0. assumption.
    - exfalso. apply H4. exists v. rewrite <- H3. assumption.
    - apply IHMapsToA; assumption.
  Qed.

  Lemma find_spec : forall s k v `{Ok s}, find k s = Some v <-> MapsTo k v s.
  Proof.
    intros. induction s as [|(k',v')].
    - intuition; inversion H0.
    - simpl. rewrite MapsTo_cons.
      destruct (X.eq_dec k k').
      + intuition.
        * left. inversion H0. intuition.
        * subst v. intuition.
        * inversion H; subst; clear H.
          exfalso. apply H3. exists v. rewrite <- e. assumption.
      + rewrite IHs. intuition. inversion H. assumption.
  Qed.

  Lemma mem_spec : forall s x `{Ok s}, mem x s = true <-> In x s.
  Proof.
    intros. split.
     - intro. induction s.
       + inversion H0.
       + destruct a.
         simpl in H0.
         destruct (X.eq_dec x k).
          * exists a. constructor. assumption.
          * assert (In x s).
              apply IHs. unfold Ok. inversion H. assumption. assumption.
            inversion H1. exists x0. constructor. assumption.
     - intro.
       induction H0.
       induction H0.
       + simpl. destruct (X.eq_dec x k).
         * reflexivity.
         * apply n in H0. inversion H0.
       + simpl. destruct (X.eq_dec x k).
         * reflexivity.
         * apply IHMapsToA. unfold Ok. inversion H. assumption.
  Qed.

  Lemma isok_iff : forall l, Ok l <-> isok l = true.
  Proof.
    intros.
    induction l as [ | (k,v) l ].
    - simpl. intuition. constructor.
    - simpl.
      rewrite andb_true_iff, negb_true_iff.
      rewrite <- IHl.
      split.
      + intro. inversion H. split.
        * apply not_true_is_false.
          assert (Ok l). unfold Ok. assumption.
          rewrite <- mem_spec in H2. assumption. assumption.
        * assumption.
      + intro. inversion H.
        constructor. intro contr.
        rewrite <- mem_spec in contr.
        rewrite H0 in contr. inversion contr.
        assumption.
        unfold Ok in H1. assumption.
  Qed.

  Global Instance isok_Ok l : isok l = true -> Ok l | 10.
  Proof.
    intro P. apply isok_iff. exact P.
  Qed.

  Lemma add_spec1: forall s k k' v `{Ok s},
     X.eq k k' -> MapsTo k v (add k' v s).
  Proof.
    intros.
    induction H.
    - constructor; assumption.
    - simpl.
      destruct (X.eq_dec k' x).
      + apply MapsTo_cons_hd. transitivity k'; assumption.
      + apply MapsTo_cons_tl. assumption.
  Qed.

  Lemma add_spec2: forall s k k' v v' `{Ok s},
     ~ X.eq k k' -> (MapsTo k v (add k' v' s) <-> MapsTo k v s).
  Proof.
    intros.
    induction H.
    - simpl. rewrite MapsTo_other. apply iff_refl. assumption.
    - simpl. destruct (X.eq_dec k' x).
      + assert (~ X.eq k x).
          intro contr. apply H0. transitivity x. assumption. symmetry. assumption.
        repeat (rewrite MapsTo_cons). intuition.
      + repeat (rewrite MapsTo_cons). intuition.
  Qed.

  Lemma add_spec2_in: forall s k k' v `{Ok s},
     ~ X.eq k k' -> (In k (add k' v s) <-> In k s).
  Proof.
    intros. unfold In.
    split; intro HM; inversion HM.
    - rewrite add_spec2 in H1. exists x. assumption. assumption. assumption.
    - exists x. rewrite add_spec2.  assumption. assumption. assumption.
  Qed.

  Global Instance add_ok s k v `(Ok s) : Ok (add k v s).
  Proof.
    induction H.
    - constructor. intro H. inversion H. inversion H0. constructor.
    - simpl. destruct (X.eq_dec k x).
      + constructor; try assumption.
      + constructor. rewrite add_spec2_in; intuition.
        assumption.
  Qed.

  Lemma remove_noop: forall s k,
    ~ In k s -> remove k s = s.
  Proof.
    intros.
    induction s as [ | (x,v) s].
    - reflexivity.
    - assert (~ In k s). intro contr. apply H. rewrite In_cons. right. assumption.
      apply IHs in H0.
      simpl.
      rewrite In_cons in H.
      rewrite H0.
      destruct (X.eq_dec k x). intuition. reflexivity.
  Qed.

  Lemma remove_spec1: forall s k k' `{Ok s},
    X.eq k k' -> ~ In k (remove k' s).
  Proof.
    intros.
    induction H.
    - intro contr. inversion contr. inversion H.
    - intro contr. simpl in contr.
      destruct (X.eq_dec k' x).
      + rewrite H0 in contr. rewrite e in contr. apply H in contr. inversion contr.
      + rewrite In_cons in contr. intuition. apply n. rewrite <- H0. assumption.
  Qed.

  Lemma remove_spec2: forall s k k' v `{Ok s},
    ~ X.eq k k' -> (MapsTo k' v (remove k s) <-> MapsTo k' v s).
  Proof.
    intros.
    induction H.
    - simpl. intuition.
    - simpl.
      destruct (X.eq_dec k x).
      + assert (~X.eq k' x). intro contr. apply H0. rewrite e. rewrite contr. intuition.
        rewrite MapsTo_cons. intuition.
      + repeat (rewrite MapsTo_cons). intuition.
  Qed.

  Lemma forall_iff_same: forall {X} (P P' : X -> Prop),
     (forall x, P x <-> P' x) -> ((exists x, P x) <-> (exists x, P' x)).
  Proof.
    intros X P P' Heq.
    split; intro H; inversion H.
    - rewrite Heq in H0. exists x. assumption.
    - rewrite <- Heq in H0. exists x. assumption.
  Qed.

  Lemma remove_spec2_In: forall s k k'`{Ok s},
    ~ X.eq k k' -> (In k' (remove k s) <-> In k' s).
  Proof.
    intros. unfold In. apply forall_iff_same. intro x. apply remove_spec2; assumption.
  Qed.

  Global Instance remove_ok s x `(Ok s) : Ok (remove x s).
  Proof.
    induction H.
    - constructor.
    - simpl. destruct (X.eq_dec x x0).
      + apply H0.
      + constructor.
        rewrite remove_spec2_In; assumption.
        assumption.
  Qed.

  Lemma singleton_ok : forall k v, Ok (singleton k v).
  Proof.
    intros.
    unfold singleton, Ok. constructors. unfold In. intro.
    inversion H. inversion H0.
  Qed.

  Lemma singleton_spec : forall k k' v,
    X.eq k k' <-> MapsTo k v (singleton k' v).
  Proof.
    intros.
    split; intro H.
    - unfold singleton. rewrite MapsTo_cons. left. split. assumption. reflexivity.
    - inversion H. assumption. inversion H1.
  Qed.

  Lemma empty_ok : Ok (empty A).
  Proof.
    unfold empty; constructors.
  Qed.

  Lemma empty_spec : Empty (empty A).
  Proof.
    unfold Empty, empty; red; intros; inv.
    unfold In in H. inversion H.
  Qed.

  Lemma is_empty_spec : forall s : t A, is_empty s = true <-> Empty s.
  Proof.
    unfold Empty; destruct s; simpl; split; intros; auto.
    - intro; inv. unfold In in H. inversion H. inversion H0.
    - inversion H.
    - assert (In (fst p) (p :: s)).
        destruct p.  unfold In. exists a. constructor.
      auto.
      unfold In in H0. inversion H0. apply H in H1. inversion H1.
  Qed.

  Lemma elements_spec1 : forall s k v,
    InA eq_key_elt (k, v) (elements s) <-> MapsTo k v s.
  Proof.
    intros. unfold elements.
    induction s as [ | (k',v') s].
    - intuition. inversion H. inversion H.
    - intuition.
      inversion H1.
      + inversion H3. simpl in H5. simpl in H6. rewrite H6. constructor. assumption.
      + constructor. apply H. assumption.
      + inversion H1.
        * constructor. unfold eq_key_elt. simpl. split. assumption. reflexivity.
        * apply InA_cons_tl. apply H0. assumption.
  Qed.

  Lemma elements_spec2w : forall s `(Ok s),
     NoDupA eq_key (@elements A s).
  Proof.
    intros.
    unfold elements.
    induction H.
    - constructor.
    - constructor.
      intro contr. apply H.
      + clear H. clear H0. clear IHNoDup.
        induction contr as [ (k,v') l | (k,v') l].
        * unfold eq_key in H. simpl in H. rewrite In_cons. left. assumption.
        * rewrite In_cons. right. assumption.
      + assumption.
  Qed.

  Lemma fold_spec : forall s (X : Type) (i : X) (f : key -> A -> X -> X),
    fold f s i = fold_left (fun (x:X) (p:key*A) => f (fst p) (snd p) x ) (elements s) i.
    intros; reflexivity.
  Qed.

  (*
  Lemma fold_spec :
   forall (s : t) (A : Type) (i : A) (f : elt -> A -> A),
   fold f s i = fold_left (flip f) (elements s) i.
  Proof.
  reflexivity.
  Qed.

  Global Instance union_ok : forall s s' `(Ok s, Ok s'), Ok (union s s').
  Proof.
  induction s; simpl; auto; intros; inv; unfold flip; auto with *.
  Qed.

  Lemma union_spec :
   forall (s s' : t) (x : elt) {Hs : Ok s} {Hs' : Ok s'},
   In x (union s s') <-> In x s \/ In x s'.
  Proof.
  induction s; simpl in *; unfold flip; intros; auto; inv.
  intuition; inv.
  rewrite IHs, add_spec, InA_cons; intuition.
  Qed.

  Global Instance inter_ok s s' `(Ok s, Ok s') : Ok (inter s s').
  Proof.
  unfold inter, fold, flip.
  set (acc := nil (A:=elt)).
  assert (Hacc : Ok acc) by constructors.
  clearbody acc; revert acc Hacc.
  induction s; simpl; auto; intros. inv.
  apply IHs; auto.
  destruct (mem a s'); auto with *.
  Qed.

  Lemma inter_spec  :
   forall (s s' : t) (x : elt) {Hs : Ok s} {Hs' : Ok s'},
   In x (inter s s') <-> In x s /\ In x s'.
  Proof.
  unfold inter, fold, flip; intros.
  set (acc := nil (A:=elt)) in *.
  assert (Hacc : Ok acc) by constructors.
  assert (IFF : (In x s /\ In x s') <-> (In x s /\ In x s') \/ In x acc).
   intuition; unfold acc in *; inv.
  rewrite IFF; clear IFF. clearbody acc.
  revert acc Hacc x s' Hs Hs'.
  induction s; simpl; intros.
  intuition; inv.
  inv.
  case_eq (mem a s'); intros Hm.
  rewrite IHs, add_spec, InA_cons; intuition.
  rewrite mem_spec in Hm; auto.
  left; split; auto. rewrite H1; auto.
  rewrite IHs, InA_cons; intuition.
  rewrite H2, <- mem_spec in H3; auto. congruence.
  Qed.

  Global Instance diff_ok : forall s s' `(Ok s, Ok s'), Ok (diff s s').
  Proof.
  unfold diff; intros s s'; revert s.
  induction s'; simpl; unfold flip; auto; intros. inv; auto with *.
  Qed.

  Lemma diff_spec  :
   forall (s s' : t) (x : elt) {Hs : Ok s} {Hs' : Ok s'},
   In x (diff s s') <-> In x s /\ ~In x s'.
  Proof.
  unfold diff; intros s s'; revert s.
  induction s'; simpl; unfold flip.
  intuition; inv.
  intros. inv.
  rewrite IHs', remove_spec, InA_cons; intuition.
  Qed.

  Lemma subset_spec :
   forall (s s' : t) {Hs : Ok s} {Hs' : Ok s'},
   subset s s' = true <-> Subset s s'.
  Proof.
  unfold subset, Subset; intros.
  rewrite is_empty_spec.
  unfold Empty; intros.
  intuition.
  specialize (H a). rewrite diff_spec in H; intuition.
  rewrite <- (mem_spec a) in H |- *. destruct (mem a s'); intuition.
  rewrite diff_spec in H0; intuition.
  Qed.

  *)

 Section EqSpec.
     Variable s s' : t A.
     Variable cmp : A -> A -> bool.
     Lemma equal_1 :
       forall `{Ok s, Ok s'},
       Equivb cmp s s' -> equal cmp s s' = true.
     Admitted.
     Lemma equal_2 :
       forall `{Ok s, Ok s'},
       equal cmp s s' = true -> Equivb cmp s s'.
     Admitted.
  End EqSpec.

  (*

  Lemma equal_spec :
   forall (s s' : t) {Hs : Ok s} {Hs' : Ok s'},
   equal s s' = true <-> Equal s s'.
  Proof.
  unfold Equal, equal; intros.
  rewrite andb_true_iff, !subset_spec.
  unfold Subset; intuition. rewrite <- H; auto. rewrite H; auto.
  Qed.

  Definition choose_spec1 :
    forall (s : t) (x : elt), choose s = Some x -> In x s.
  Proof.
  destruct s; simpl; intros; inversion H; auto.
  Qed.

  Definition choose_spec2 : forall s : t, choose s = None -> Empty s.
  Proof.
  destruct s; simpl; intros.
  intros x H0; inversion H0.
  inversion H.
  Qed.
  *)

  Lemma cardinal_spec : forall s `{Ok s}, cardinal s = length (elements s).
  Proof. auto. Qed.

  (*
  Lemma filter_spec' : forall s x f,
   In x (filter f s) -> In x s.
  Proof.
  induction s; simpl.
  intuition; inv.
  intros; destruct (f a); inv; intuition; right; eauto.
  Qed.
  *)

  Lemma filter_spec : forall s k v f,
    Proper (X.eq==>Logic.eq==>Logic.eq) f ->
    (MapsTo k v (filter f s) <-> MapsTo k v s /\ f k v = true).
  Proof.
    intros.
    induction s as [|(k',v')].
    simpl.
    - split; intro H'; inversion H'; try inversion H0.
    - simpl.
      destruct (f k' v') eqn:Hf.
      + repeat (rewrite MapsTo_cons).
        intuition.
        rewrite <- H4 in Hf.
        rewrite <- H1 in Hf.
        assumption.
      + rewrite MapsTo_cons.
        rewrite IHs.
        intuition.
        rewrite <- H3 in Hf.
        rewrite <- H5 in Hf.
        rewrite Hf in H4.
        inversion H4.
  Qed.

  Lemma filter_In: forall f k l, ~ In k l -> ~ In k (filter f l).
  Proof.
    intros.
    induction l as [|(k',v')]; simpl.
    - apply H.
    - destruct (f k' v').
      + rewrite In_cons.
        rewrite In_cons in H.
        intuition.
      + rewrite In_cons in H.
        intuition.
  Qed.

  Lemma filter_NoDup: forall f l, NoDup l -> NoDup (filter f l).
  Proof.
    intros.
    induction H.
    - constructor.
    - simpl.
      destruct (f x v).
      + constructor.
        * apply filter_In. assumption.
        * assumption.
      + assumption.
  Qed.

  Global Instance filter_ok s f `(Ok s) : Ok (filter f s).
  Proof.
    unfold Ok in H.
    induction H.
    - constructor.
    - simpl.
      destruct (f x v).
      + constructor.
        * apply filter_In. assumption.
        * apply filter_NoDup. assumption.
      + assumption.
  Qed.

  Lemma for_all_spec : forall s f,
    Proper (X.eq==>Logic.eq==>Logic.eq) f ->
    (for_all f s = true <-> For_all (fun x a => f x a = true) s).
  Proof.
    intros.
    unfold For_all.
    induction s as [|(k,v)].
    - simpl. split; intro.
      + intros k a contr. inversion contr.
      + reflexivity.
    - simpl.
      destruct (f k v) eqn:Hf.
      + split.
        * intros Hfa k0 a HMt.
          inversion HMt; subst; clear HMt.
          rewrite H1. assumption.
          apply IHs. assumption. assumption.
        * intros Hfa.
          apply IHs.
          intros k0 a HMt.
          apply Hfa.
          constructor. assumption.
      + split.
        * intro contr. inversion contr.
        * intro Hfa.
          assert (MapsTo k v ((k, v) :: s)) by ( constructor; reflexivity).
          specialize (Hfa k v H0).
          rewrite Hf in Hfa. assumption.
  Qed.

  Lemma exists_false_forall_true: forall A f (s : t A),
   (exists_ f s = true <-> for_all (fun k v => negb (f k v)) s = false).
  Proof.
    intros.
    induction s as [|(k,v)].
    - simpl. intuition.
    - simpl. destruct (f k v); intuition.
  Qed.

  Lemma  exists_spec : forall s f ,
    Proper (X.eq==>Logic.eq==>Logic.eq) f ->
    (exists_ f s = true <-> Exists (fun x a => f x a = true) s).
  Proof.
    intros.
    unfold For_all.
    induction s as [|(k,v)].
    - simpl. split; intro.
      + inversion H0.
      + unfold Exists in H0. inversion H0. inversion H1. inversion H2. inversion H3.
    - simpl.
      destruct (f k v) eqn:Hf.
      + split.
        * intros.
          exists k. exists v.
          split ; [constructor;  reflexivity | assumption].
        * intro He. reflexivity.
      + split.
        * intros.
          apply IHs in H0.
          inversion H0. inversion_clear H1. inversion_clear H2.
          exists x. exists x0.
          split ; [constructor;  assumption | assumption].
        * intro He.
          inversion_clear He. inversion_clear H0. inversion_clear H1.
          inversion H0; subst; clear H0.
          rewrite H3 in H2. rewrite H2 in Hf. inversion Hf.
          apply IHs.
          exists x. exists x0.
          split ; assumption.
  Qed.

  Lemma partition_spec1 : forall s f,
    Proper (X.eq==>Logic.eq==>Logic.eq) f ->
    Equal (fst (partition f s)) (filter f s).
  Admitted.

  (*
  Lemma partition_spec1 :
   forall (s : t) (f : elt -> bool),
   Proper (X.eq==>eq) f ->
   Equal (fst (partition f s)) (filter f s).
  Proof.
  simple induction s; simpl; auto; unfold Equal.
  firstorder.
  intros x l Hrec f Hf.
  generalize (Hrec f Hf); clear Hrec.
  case (partition f l); intros s1 s2; simpl; intros.
  case (f x); simpl; firstorder; inversion H0; intros; firstorder.
  Qed.
  *)

  Lemma partition_spec2 : forall s f,
    Proper (X.eq==>Logic.eq==>Logic.eq) f ->
    Equal (snd (partition f s)) (filter (fun x a => negb (f x a)) s).
  Admitted.

  (*
  Lemma partition_spec2 :
   forall (s : t) (f : elt -> bool),
   Proper (X.eq==>eq) f ->
   Equal (snd (partition f s)) (filter (fun x => negb (f x)) s).
  Proof.
  simple induction s; simpl; auto; unfold Equal.
  firstorder.
  intros x l Hrec f Hf.
  generalize (Hrec f Hf); clear Hrec.
  case (partition f l); intros s1 s2; simpl; intros.
  case (f x); simpl; firstorder; inversion H0; intros; firstorder.
  Qed.
  *)

  (*
  Lemma partition_ok1' :
   forall (s : t) {Hs : Ok s} (f : elt -> bool)(x:elt),
    In x (fst (partition f s)) -> In x s.
  Proof.
  induction s; simpl; auto; intros. inv.
  generalize (IHs H1 f x).
  destruct (f a); destruct (partition f s); simpl in *; auto.
  inversion_clear H; auto.
  Qed.

  Lemma partition_ok2' :
   forall (s : t) {Hs : Ok s} (f : elt -> bool)(x:elt),
    In x (snd (partition f s)) -> In x s.
  Proof.
  induction s; simpl; auto; intros. inv.
  generalize (IHs H1 f x).
  destruct (f a); destruct (partition f s); simpl in *; auto.
  inversion_clear H; auto.
  Qed.
  *)

  Global Instance partition_ok1 : forall s f `(Ok s), Ok (fst (partition f s)).
  Admitted.
  (*
  Proof.
  simple induction s; simpl.
  auto.
  intros x l Hrec f Hs; inv.
  generalize (@partition_ok1' _ _ f x).
  generalize (Hrec f H0).
  case (f x); case (partition f l); simpl; constructors; auto.
  Qed.
  *)

  Global Instance partition_ok2 : forall s f `(Ok s), Ok (snd (partition f s)).
  Admitted.
(*
  Proof.
  simple induction s; simpl.
  auto.
  intros x l Hrec f Hs; inv.
  generalize (@partition_ok2' _ _ f x).
  generalize (Hrec f H0).
  case (f x); case (partition f l); simpl; constructors; auto.
  Qed.
*)

  Lemma choose_spec1 : forall s k v,
     choose s = Some (k,v) -> MapsTo k v s.
  Proof.
    intros.
    destruct s as [|(k',v')].
    - inversion H.
    - inversion H. constructor. reflexivity.
  Qed.

  Lemma choose_spec2 : forall s , choose s = None -> Empty s.
  Proof.
    intros.
    destruct s as [|(k',v')].
    - inversion H. apply empty_spec.
    - inversion H.
  Qed.

  (* Definition In := InA X.eq. *)
  Definition eq := Equal.
  Instance eq_equiv : Equivalence eq := _. Admitted.
  End ForNotations.

  Lemma map_spec1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'),
                      MapsTo x e m -> MapsTo x (f e) (map f m).
    intros. induction H; constructor; assumption.
  Qed.

  Lemma map_spec2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'),
                      In x (map f m) -> In x m.
    intros.
    remember (map f m) as m'.
    generalize dependent m.
    induction H using In_ind.
    - intros.
      destruct m0 as [|(k'',v') m0]; inversion Heqm'; subst; clear Heqm'.
      rewrite In_cons. left. assumption.
    - intros.
      destruct m0 as [|(k'',v'') m0]; inversion Heqm'; subst; clear Heqm'.
      rewrite In_cons. right. apply IHIn. reflexivity.
  Qed.

  Lemma mapi_spec1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)
                        (f:key->elt->elt'), MapsTo x e m ->
                                            exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m).
    intros.
    induction H.
    - exists k. split.
      + symmetry; assumption.
      + constructor; assumption.
    - inversion_clear IHMapsToA.
      inversion_clear H0.
      exists x0. split.
      + assumption.
      + constructor. assumption.
  Qed.

  Lemma mapi_spec2 : forall (elt elt':Type)(m: t elt)(x:key)
                            (f:key->elt->elt'), In x (mapi f m) -> In x m.
  Proof.
    intros.
    remember (mapi f m) as m'.
    generalize dependent m.
    induction H using In_ind.
    - intros.
      destruct m0 as [|(k'',v') m0]; inversion Heqm'; subst; clear Heqm'.
      rewrite In_cons. left. assumption.
    - intros.
      destruct m0 as [|(k'',v'') m0]; inversion Heqm'; subst; clear Heqm'.
      rewrite In_cons. right. apply IHIn. reflexivity.
  Qed.

  Lemma map2_spec1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt')
	                        (x:key)(f:option elt->option elt'->option elt''),
	                   In x m \/ In x m' ->
                       find x (map2 f m m') = f (find x m) (find x m').
  Admitted.

  Lemma map2_spec2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt')
	                        (x:key)(f:option elt->option elt'->option elt''),
                       In x (map2 f m m') -> In x m \/ In x m'.
  Admitted.

  Instance mapi_ok A A' s (g: key -> A -> A') `(Ok A s): Ok (mapi g s).
  Proof.
    intros. induction H.
    - constructor.
    - simpl. constructor.
      + intro contr. apply H. clear H.
        apply mapi_spec2 in contr.
        unfold In in contr. assumption.
      + assumption.
  Qed.

  Instance map_ok A A' s (g: A -> A') `(Ok A s): Ok (map g s).
  Proof.
    unfold map.
    apply mapi_ok.
    assumption.
  Qed.

  Instance map2_ok A A' A'' s s'
          (g: option A -> option A' -> option A'') `(Ok A s): Ok (map2 g s s').
  Admitted.
End MakeRaw.

(** * Encapsulation

   Now, in order to really provide a functor implementing [S], we
   need to encapsulate everything into a type of lists without redundancy. *)

Module Make (X: DecidableType) <: WMaps with Module E := X.
 Module Raw := MakeRaw X.
 Include WRaw2Maps X Raw.
End Make.


Require Import Crypto.Specific.Framework.SynthesisFramework.
Require Import Crypto.Specific.solinas32_2e192m2e64m1_9limbs.CurveParameters.

Module P <: PrePackage.
  Definition package : Tag.Context.
  Proof. make_Synthesis_package curve extra_prove_mul_eq extra_prove_square_eq. Defined.
End P.

Module Export S := PackageSynthesis P.


Require Import Crypto.Specific.Framework.SynthesisFramework.
Require Import Crypto.Specific.solinas64_2e256m4294968273_10limbs.CurveParameters.

Module P <: PrePackage.
  Definition package : Tag.Context.
  Proof. make_Synthesis_package curve extra_prove_mul_eq extra_prove_square_eq. Defined.
End P.

Module Export S := PackageSynthesis P.


Require Import Crypto.Specific.Framework.SynthesisFramework.
Require Import Crypto.Specific.solinas64_2e216m2e108m1_4limbs.CurveParameters.

Module P <: PrePackage.
  Definition package : Tag.Context.
  Proof. make_Synthesis_package curve extra_prove_mul_eq extra_prove_square_eq. Defined.
End P.

Module Export S := PackageSynthesis P.


Require Import Crypto.Specific.Framework.SynthesisFramework.
Require Import Crypto.Specific.solinas64_2e322m2e161m1_6limbs.CurveParameters.

Module P <: PrePackage.
  Definition package : Tag.Context.
  Proof. make_Synthesis_package curve extra_prove_mul_eq extra_prove_square_eq. Defined.
End P.

Module Export S := PackageSynthesis P.


Require Import Mem.
Require Import Prog.
Require Import Log.
Require Import BFile.
Require Import Word.
Require Import BasicProg.
Require Import Bool.
Require Import Pred.
Require Import Hoare.
Require Import GenSepN.
Require Import SepAuto.
Require Import Idempotent.
Require Import Inode.
Require Import List.
Require Import Balloc.
Require Import Arith.
Require Import Array.
Require Import FSLayout.
Require Import Cache.
Require Import Rec.
Require Import FileRecArray RecArrayUtils LogRecArray.
Require Import Omega.
Require Import Eqdep_dec.
Require Import Bytes.
Require Import ProofIrrelevance.
Require Import Rounding.

Set Implicit Arguments.
Import ListNotations.

(** A byte-based interface to a BFileRec. Fast because it uses the range
update operation in BFileRec to do writes, and exposes an API that uses
[byte count]s rather than [list byte]s as inputs. *)
Module FASTBYTEFILE.

  Definition byte_type := Rec.WordF 8.
  Definition itemsz := Rec.len byte_type.
  Definition items_per_valu : addr := $ valubytes.
  Theorem itemsz_ok : valulen = wordToNat items_per_valu * itemsz.
  Proof.
    unfold items_per_valu.
    rewrite valulen_is, valubytes_is.
    reflexivity.
  Qed.

  (* The bytes of a file are mapped onto a list of blocks:   *)
  (*   [ block 0 ... block n]                                *)
  (*   <-- allbytes      -->                                 *)
  (*   <-- bytes     -->                                     *)

  Definition bytes_rep f (allbytes : list byte) :=
    BFileRec.array_item_file byte_type items_per_valu itemsz_ok f allbytes /\
    # (natToWord addrlen (length allbytes)) = length allbytes.

  Definition rep (bytes : list byte) (f : BFILE.bfile) :=
    exists allbytes,
    bytes_rep f allbytes /\
    firstn (# (f.(BFILE.BFAttr).(INODE.ISize))) allbytes = bytes /\
    length bytes = (# (f.(BFILE.BFAttr).(INODE.ISize))) /\
    divup # (INODE.ISize (BFILE.BFAttr f)) valubytes * valubytes = length allbytes.

  Lemma block_items_ok : block_items items_per_valu = valubytes.
  Proof.
    unfold block_items.
    unfold items_per_valu.
    rewrite valubytes_is.
    reflexivity.
  Qed.

  (* roundup_ge specialized to valubytes *)
  Lemma roundup_valu_ge : forall n, n <= roundup n valubytes.
  Proof.
    intros.
    apply roundup_ge.
    rewrite valubytes_is.
    (* produces a nicer proof term than omega *)
    apply gt_Sn_O.
  Qed.

  Definition hidden (P : Prop) : Prop := P.
  Opaque hidden.

  Definition update_bytes T fsxp inum (off : nat) len (newbytes : bytes len) mscs rx : prog T :=
  If (lt_dec 0 len) {
    let^ (mscs) <- BFileRec.bf_update_range items_per_valu itemsz_ok
      fsxp inum off newbytes mscs;
    rx ^(mscs)
  } else {
    rx ^(mscs)
  }.

  Inductive byte_buf : Set :=
  | len_bytes : forall (len:nat), bytes len -> byte_buf.

  Definition buf_len (buf:byte_buf) : nat :=
  match buf with
  | @len_bytes len _ => len
  end.

  Definition buf_data (buf:byte_buf) : bytes (buf_len buf) :=
  match buf with
  | @len_bytes _ b => b
  end.

  Definition read_bytes T fsxp inum (off:nat) len mscs rx : prog T :=
  If (lt_dec 0 len) {
    let^ (mscs, attr) <- BFILE.bfgetattr (FSXPLog fsxp) (FSXPInode fsxp) inum mscs;
    let flen := # (INODE.ISize attr) in
    If (lt_dec off flen) {
      If (lt_dec (off+len) flen) {
        let^ (mscs, data) <- BFileRec.bf_read_range items_per_valu itemsz_ok
          fsxp inum off len mscs;
        rx ^(mscs, len_bytes data)
      } else {
        let^ (mscs, data) <- BFileRec.bf_read_range items_per_valu itemsz_ok
          fsxp inum off (flen - off) mscs;
        rx ^(mscs, len_bytes data)
      }
   } else {
    (* reading starting at or past the end of the file *)
    rx ^(mscs, @len_bytes 0 (wzero _))
   }
  } else {
    (* reading zero bytes *)
    rx ^(mscs, @len_bytes 0 (wzero _))
  }.

  Implicit Arguments read_bytes [T].

  Lemma list2nmem_array_eq' : forall A (l l':list A),
    l = l' ->
    arrayN 0 l (list2nmem l').
  Proof.
    intros.
    rewrite H.
    apply list2nmem_array.
  Qed.

  Lemma sep_star_abc_to_acb : forall AT AEQ AV (a b c : @pred AT AEQ AV),
    (a * b * c)%pred =p=> (a * c * b).
  Proof. cancel. Qed.

  Lemma list2nmem_arrayN_xyz_frame : forall (A:Type) (l:list A)
    off len,
    off + len <= length l ->
    (arrayN 0 (firstn off l) *
    arrayN (off+len) (skipn (off+len) l) *
    arrayN off (firstn len (skipn off l)))%pred (list2nmem l).
  Proof.
    intros.
    apply sep_star_abc_to_acb.
    rewrite arrayN_combine by LOG.solve_lengths.
    apply arrayN_combine.
    LOG.solve_lengths.
    apply list2nmem_array_eq'.
    rewrite <- firstn_sum_split.
    apply firstn_skipn.
  Qed.

  Theorem read_bytes_ok: forall fsxp inum off len mscs,
  {< m mbase F Fm A flist f bytes,
  PRE LOG.rep (FSXPLog fsxp) F (ActiveTxn mbase m) mscs *
      [[ (Fm * BFILE.rep (FSXPBlockAlloc fsxp) (FSXPInode fsxp) flist)%pred (list2mem m) ]] *
      [[ (A * #inum |-> f)%pred (list2nmem flist) ]] *
      [[ rep bytes f ]]
   POST RET:^(mscs, b)
      exists Fx v,
      LOG.rep (FSXPLog fsxp) F (ActiveTxn mbase m) mscs *
      [[ (Fx * arrayN off v)%pred (list2nmem bytes) ]] *
      [[ @Rec.of_word (Rec.ArrayF byte_type (buf_len b))
        (buf_data b) = v ]] *
      (* non-error guarantee *)
      [[ 0 < len -> off < # (INODE.ISize (BFILE.BFAttr f)) ->
         0 < buf_len b ]]
   CRASH LOG.would_recover_old (FSXPLog fsxp) F mbase
   >} read_bytes fsxp inum off len mscs.
   Proof.
    unfold read_bytes, rep, bytes_rep.
    time step. (* 15s *)
    step.
    step.
    step.
    step.

    eapply goodSize_word_bound.
    eapply le_trans.
    apply divup_lt_arg.
    apply Nat.lt_le_incl; eauto.

    erewrite array_items_num_blocks; eauto.
    apply divup_mono.
    eapply le_trans.
    apply Nat.lt_le_incl; eauto.
    apply firstn_length_l_iff; auto.

    step.
    rewrite H15.
    rewrite <- firstn_double_skipn
      with (len2 := # (INODE.ISize (BFILE.BFAttr f)))
      by omega.
    apply list2nmem_arrayN_xyz_frame.
    omega.

    step.
    rewrite le_plus_minus_r by omega.
    eapply goodSize_word_bound.
    eapply le_trans.
    apply divup_lt_arg.
    eauto.

    rewrite le_plus_minus_r by omega.
    erewrite BFileRec.array_items_num_blocks; eauto.
    apply divup_mono.
    apply firstn_length_l_iff; auto.

    step.
    rewrite H15.
    rewrite <- firstn_double_skipn
      with (len2 := # (INODE.ISize (BFILE.BFAttr f)))
      by omega.
    apply list2nmem_arrayN_xyz_frame.
    rewrite H4.
    omega.

    step.
    (* off out of bounds *)
    apply emp_star_r.
    apply list2nmem_array.

    (* len = 0 *)
    step.
    apply emp_star_r.
    apply list2nmem_array.
  Qed.

  Hint Extern 1 ({{_}} progseq (read_bytes _ _ _ _ _) _) => apply read_bytes_ok : prog.

  Theorem update_bytes_ok: forall fsxp inum off len (newbytes : bytes len) mscs,
      {< m mbase F Fm A flist f bytes olddata Fx,
       PRE LOG.rep (FSXPLog fsxp) F (ActiveTxn mbase m) mscs *
           [[ (Fm * BFILE.rep (FSXPBlockAlloc fsxp) (FSXPInode fsxp) flist)%pred (list2mem m) ]] *
           [[ (A * #inum |-> f)%pred (list2nmem flist) ]] *
           [[ rep bytes f ]] *
           [[ (Fx * arrayN off olddata)%pred (list2nmem bytes) ]] *
           [[ length olddata = len ]]
      POST RET: ^(mscs)
           exists m' flist' f' bytes',
           LOG.rep (FSXPLog fsxp) F (ActiveTxn mbase m') mscs *
           [[ (Fm * BFILE.rep (FSXPBlockAlloc fsxp) (FSXPInode fsxp) flist')%pred (list2mem m') ]] *
           [[ (A * #inum |-> f')%pred (list2nmem flist') ]] *
           [[ rep bytes' f' ]] *
           [[ let newdata := @Rec.of_word (Rec.ArrayF byte_type len) newbytes in
              (Fx * arrayN off newdata)%pred (list2nmem bytes') ]] *
           [[ hidden (BFILE.BFAttr f = BFILE.BFAttr f') ]]
       CRASH LOG.would_recover_old (FSXPLog fsxp) F mbase
      >} update_bytes fsxp inum off newbytes mscs.
  Proof.
    unfold update_bytes.
    time step. (* 40s *)
    inversion H6 as [allbytes Hrepconj].
    inversion Hrepconj as [Hbytes_rep Hrepconj']; clear Hrepconj.
    inversion Hbytes_rep as [Hrecrep Hallbytes_goodSize].
    (* TODO: replace this with filelen f *)
    set (flen := # (INODE.ISize (BFILE.BFAttr f))) in *.

    time step. (* 50s *)
    - instantiate (Fx0 := (Fx * arrayN flen
        (skipn flen allbytes))%pred).
      rewrite <- firstn_skipn with (l := allbytes) (n := flen) at 2.
      replace (firstn flen allbytes).
      replace flen with (length bytes) at 1.
      apply list2nmem_arrayN_app with (l' := skipn flen allbytes) in H5.
      pred_apply; cancel.
      cancel.
    - reflexivity.
    - unfold BFileRec.hidden.
      rewrite Rec.array_of_word_length with (ft := byte_type).
      auto.
    - unfold BFileRec.hidden in *.
      fold byte in *.
      step.
      * unfold rep.
        exists ilist'.
        split; [|split]; eauto.
        split; auto.
        eapply wordToNat_natToWord_bound.
        eapply BFileRec.bfrec_bound with (itemtype := byte_type); eauto.
        split.
        subst.
        apply firstn_length_l.
        replace (length ilist').
        replace (BFILE.BFAttr f').
        apply firstn_length_l_iff; auto.
        replace (length ilist').
        replace (BFILE.BFAttr f').
        auto.
      * replace (BFILE.BFAttr f').
        apply firstn_length_l_iff in H10.
        fold flen.
        match goal with
        | [ H : _ (list2nmem ilist') |- _ ] => rename H into Hilist'
        end.
        rewrite <- firstn_skipn with (l := ilist') (n := flen) in Hilist'.
        assert (length (firstn flen ilist') = flen) as Hflen.
        apply firstn_length_l; omega.

        eapply pimpl_apply in Hilist'; [|apply sep_star_abc_to_acb].
        rewrite <- Hflen in Hilist' at 1.
        assert (Htails_eq := Hilist').
        apply list2nmem_arrayN_end_eq in Htails_eq; auto.
        rewrite Htails_eq in Hilist'.
        apply list2nmem_arrayN_app_iff in Hilist'.
        assumption.
        exact ($ 0).
        autorewrite with lengths; omega.
    - (* no-op case len = 0 *)
      step.
      assert (olddata = nil) by (apply length_nil; omega).
      subst olddata.
      simpl.
      pred_apply; cancel.
  Qed.

  Hint Extern 1 ({{_}} progseq (update_bytes ?fsxp ?inum ?off ?newbytes _) _) =>
    apply update_bytes_ok with (fsxp:=fsxp) (inum:=inum) (off:=off) (newbytes:=newbytes) : prog.

   Definition grow_file T fsxp inum newlen mscs rx : prog T :=
    let^ (mscs, oldattr) <- BFILE.bfgetattr fsxp.(FSXPLog) fsxp.(FSXPInode) inum mscs;
    let oldlen := oldattr.(INODE.ISize) in
    If (wlt_dec oldlen ($ newlen)) {
      let^ (mscs, ok) <- bf_expand items_per_valu fsxp inum newlen mscs;
      If (bool_dec ok true) {
        let zeros := @natToWord ((roundup newlen valubytes-#oldlen)*8) 0 in
        let^ (mscs) <- bf_update_range items_per_valu itemsz_ok
           fsxp inum #oldlen zeros mscs;
         mscs <- BFILE.bfsetattr fsxp.(FSXPLog) fsxp.(FSXPInode) inum
                                (INODE.Build_iattr ($ newlen)
                                                   (INODE.IMTime oldattr)
                                                   (INODE.IType oldattr)) mscs;
        rx ^(mscs, true)
      } else {
        rx ^(mscs, false)
      }
    } else {
      rx ^(mscs, true)
    }.

  Definition filelen f := # (INODE.ISize (BFILE.BFAttr f)).

  Theorem grow_file_ok: forall fsxp inum newlen mscs,
    {< m mbase F Fm A flist f bytes,
      PRE LOG.rep (FSXPLog fsxp) F (ActiveTxn mbase m) mscs *
           [[ (Fm * BFILE.rep (FSXPBlockAlloc fsxp) (FSXPInode fsxp) flist)%pred (list2mem m) ]] *
           [[ (A * #inum |-> f)%pred (list2nmem flist) ]] *
           [[ rep bytes f ]] *
           [[ goodSize addrlen newlen ]] *
           (* spec requires that file is growing, so that it can guarantee
              that the new size of the file is $newlen. *)
           [[ filelen f <= newlen ]]
      POST RET:^(mscs, ok)
           exists m', LOG.rep (FSXPLog fsxp) F (ActiveTxn mbase m') mscs *
           ([[ ok = false ]] \/
           [[ ok = true ]] * exists flist' f' bytes' fdata' attr,
           [[ (Fm * BFILE.rep (FSXPBlockAlloc fsxp) (FSXPInode fsxp) flist')%pred (list2mem m') ]] *
           [[ (A * #inum |-> f')%pred (list2nmem flist') ]] *
           [[ bytes' = (bytes ++ (repeat $0 (newlen -  (# (INODE.ISize (BFILE.BFAttr f)))))) ]] *
           [[ rep bytes' f']] *
           [[ attr = INODE.Build_iattr ($ newlen) (f.(BFILE.BFAttr).(INODE.IMTime)) (f.(BFILE.BFAttr).(INODE.IType))]] *
           [[ f' = BFILE.Build_bfile fdata' attr]])
       CRASH LOG.would_recover_old (FSXPLog fsxp) F mbase
     >} grow_file fsxp inum newlen mscs.
   Proof.
     unfold grow_file, rep, bytes_rep.
     time step. (* 30s *)
     step.
     time step. (* 10s *)

     fold (filelen f) in *.
     instantiate (Fi := arrayN 0 allbytes).
     apply list2nmem_array.
     apply firstn_length_l_iff in H6.
     unfold ge.
     fold (filelen f) in H10.
     fold byte.
     replace (length allbytes).
     fold (roundup (filelen f) valubytes).
     rewrite block_items_ok.
     apply roundup_mono.
     apply Nat.lt_le_incl.
     unfold filelen.
     apply lt_word_lt_nat; auto.

     assert (filelen f < newlen) as Hnewlen.
     apply lt_word_lt_nat; auto.
     assert (Hflenround := roundup_valu_ge (filelen f)).
     assert (Hnewlenround := roundup_valu_ge newlen).
     assert (roundup (filelen f) valubytes <= roundup newlen valubytes) as
      Hnewlen_round.
     apply roundup_mono; omega.
     assert (filelen f <= length allbytes) as Hflen_all.
     replace (length allbytes).
     apply roundup_valu_ge.
     assert (Init.Nat.min (filelen f) (length allbytes) =
      filelen f) as Hlen_all_min.
     apply Nat.min_l; auto.

     step.
     time step. (* 60s *)
     step.

     time step. (* 80s *)
     fold (filelen f) in *.
     apply firstn_length_l_iff in H6.
     instantiate (Fx0 := arrayN 0 (firstn (filelen f) allbytes)).
     instantiate (olddata0 := skipn (filelen f) (allbytes ++ a7)).
     replace (firstn (filelen f) allbytes) with
      (firstn (filelen f) (allbytes ++ a7)) at 1.
     apply list2nmem_arrayN_firstn_skipn.
     apply firstn_app_l; omega.
     reflexivity.
     unfold BFileRec.hidden.
     fold (filelen f).
     assert (Hlen := Rec.array_of_word_length
      byte_type (roundup newlen valubytes - filelen f) ($ 0)).
     simpl in Hlen.
     fold byte in *.
     rewrite Hlen; clear Hlen.
     fold (filelen f) in *.
     assert (length (allbytes ++ a7) = roundup newlen valubytes)
      as Hallbytes'len.
     rewrite app_length.
     replace (length a7).
     unfold alloc_items.
     rewrite block_items_ok.
     replace (length allbytes).
     fold (roundup (filelen f) valubytes).
     omega.
     rewrite skipn_length.
     omega.
     omega.
     fold (filelen f).
     omega.

     step.
     time step. (* 15s *)
     apply pimpl_or_r; right.
     cancel.
     fold (filelen f) in *.
     rewrite wordToNat_natToWord_idempotent'; auto.
     exists (firstn (filelen f) allbytes ++
      repeat $0 (roundup newlen valubytes - filelen f)).
     assert (ilist' =
      firstn (filelen f) allbytes ++
      repeat $ (0) (roundup newlen valubytes - filelen f)) as Hilist'.
     eapply pimpl_apply in H25.
     eapply list2nmem_array_eq in H25.
     replace ilist'.
     reflexivity.
     rewrite Rec.of_word_zero_list.
     replace (@Rec.of_word byte_type $0) with
      (natToWord 8 0) by reflexivity.
     apply arrayN_combine.
     rewrite firstn_length_l by auto.
     reflexivity.
     fold (roundup newlen valubytes).
     autorewrite with lengths.
     rewrite Hlen_all_min.
     rewrite <- Hilist'.
     intuition.

     apply wordToNat_natToWord_idempotent'.
     replace (filelen f + (roundup newlen valubytes - filelen f))
      with (length ilist').
     eapply goodSize_bound.
     eapply BFileRec.bfrec_bound with (itemtype := byte_type); eauto.
     replace ilist'.
     autorewrite with lengths.
     omega.
     replace ilist'.
     (* split repeat into two parts - those that bring the length up to newlen,
        and then the rest that make it roundup newlen *)
     replace (roundup newlen valubytes - filelen f) with
      (newlen - filelen f + (roundup newlen valubytes - newlen)) by omega.
     rewrite <- repeat_app.
     rewrite app_assoc.
     rewrite firstn_app_l by (autorewrite with lengths; omega).
     rewrite firstn_oob by (autorewrite with lengths; omega).
     reflexivity.

     step.
     step.

     assert (filelen f = newlen) as Hflen.
     case_eq (wlt_dec (INODE.ISize (BFILE.BFAttr f)) ($ (newlen))); intros.
     contradiction.
     assert (filelen f >= newlen).
     erewrite <- wordToNat_natToWord_idempotent'; eauto.
     unfold filelen.
     apply le_word_le_nat.
     rewrite natToWord_wordToNat.
     auto.
     omega.
     apply pimpl_or_r; right.
     cancel.
     unfold filelen.
     rewrite natToWord_wordToNat.
     instantiate (fdata' := (BFILE.BFData f)).
     destruct f.
     destruct BFAttr.
     auto.
     exists allbytes.
     fold (filelen f).
     rewrite minus_diag.
     simpl.
     rewrite app_nil_r.
     rewrite wordToNat_natToWord_idempotent'
      with (n := filelen f) by auto.
     auto.

   Grab Existential Variables.
   all: try exact nil.
   all: try exact emp.
   exact BFILE.bfile0.
  Qed.

  Hint Extern 1 ({{_}} progseq (grow_file _ _ _ _) _) => apply grow_file_ok : prog.

  (** Write bytes follows POSIX, which is overloaded to do two things:
  (1) if the write falls within the bounds of the file, update those bytes
  (2) otherwise, grow the file and update the new file (any grown bytes not
  updated are zeroed).

  We provide APIs for the two cases with separate specs: [update_bytes]
  and [overwrite_append]. *)
  Definition write_bytes T fsxp inum (off : nat) len (data : bytes len) mscs rx : prog T :=
    let newlen := off + len in
    let^ (mscs, oldattr) <- BFILE.bfgetattr fsxp.(FSXPLog) fsxp.(FSXPInode)
      inum mscs;
    let curlen := oldattr.(INODE.ISize) in
    (* should we grow the file? *)
    mscs <- IfRx irx (wlt_dec curlen ($ newlen)) {
      let^ (mscs, ok) <- grow_file fsxp inum newlen mscs;
      If (bool_dec ok true) {
        irx mscs
      } else {
        rx ^(mscs, false)
      }
    } else {
      irx mscs
    };
    let^ (mscs) <- update_bytes fsxp inum off data mscs;
    rx ^(mscs, true).

  (** Case (2) of [write_bytes] above, where the file must be grown.

  This is an alias for [write_bytes] since [write_bytes] already handles
  all the cases, but has its own idiosyncratic spec. *)
  Definition append T fsxp inum (off:nat) len (data : bytes len) mscs rx : prog T :=
    write_bytes fsxp inum off data mscs rx.

  Theorem append_ok: forall fsxp inum (off:nat) len (newbytes: bytes len) mscs,
    {< m mbase F Fm Fi A flist f bytes,
      PRE LOG.rep (FSXPLog fsxp) F (ActiveTxn mbase m) mscs *
           [[ (Fm * BFILE.rep (FSXPBlockAlloc fsxp) (FSXPInode fsxp) flist)%pred (list2mem m) ]] *
           [[ (A * #inum |-> f)%pred (list2nmem flist) ]] *
           [[ rep bytes f ]] *
           [[ Fi (list2nmem bytes) ]] *
           [[ goodSize addrlen (off + len) ]] *
           (* makes this an append *)
           [[ filelen f <= off ]]
       POST RET:^(mscs, ok)
           exists m', LOG.rep (FSXPLog fsxp) F (ActiveTxn mbase m') mscs *
           ([[ ok = false ]] \/
           [[ ok = true ]] * exists flist' f' bytes' zeros,
           [[ (Fm * BFILE.rep (FSXPBlockAlloc fsxp) (FSXPInode fsxp) flist')%pred (list2mem m') ]] *
           [[ (A * #inum |-> f')%pred (list2nmem flist') ]] *
           [[ rep bytes' f' ]] *
           [[ let newdata := @Rec.of_word (Rec.ArrayF byte_type len) newbytes in
              (Fi * zeros * arrayN off newdata)%pred (list2nmem bytes')]] *
           [[ zeros = arrayN (filelen f) (repeat $0 (off - (filelen f))) ]])
       CRASH LOG.would_recover_old (FSXPLog fsxp) F mbase
      >} append fsxp inum off newbytes mscs.
  Proof.
    unfold append, write_bytes.
    time step. (* 50s *)
    inversion H7 as [allbytes Hrepconj].
    inversion Hrepconj as [Hbytes_rep Hrepconj']; clear Hrepconj.
    inversion Hrepconj' as [Hbytes Hrepconj'']; clear Hrepconj'.
    inversion Hrepconj'' as [Hbyteslen Hallbyteslen]; clear Hrepconj''.
    inversion Hbytes_rep as [Hrecrep Hallbytes_goodSize].
    fold (filelen f) in *.
    assert (filelen f <= length allbytes).
    rewrite <- Hallbyteslen.
    apply roundup_valu_ge.

    step.
    time step. (* 10s *)

    unfold filelen.
    auto.

    step.
    time step. (* 165s -> 7.5s !!! *)
    step.
    time step. (* 165s -> 13s *)

    instantiate (Fx0 := (Fi * arrayN (filelen f) (repeat $0 (off - filelen f)))%pred).
    instantiate (olddata0 := repeat $0 len).
    fold (filelen f) in *.
    eapply pimpl_apply with (p := (Fi *
      arrayN (filelen f) (repeat $0 (off + len - filelen f)))%pred).
    cancel.
    replace (off + len - filelen f) with (off - filelen f + len) by omega.
    rewrite <- repeat_app.
    apply arrayN_combine.
    rewrite repeat_length.
    omega.
    replace (filelen f) at 1.
    apply list2nmem_arrayN_app.
    auto.

    autorewrite with lengths.
    reflexivity.

    time step. (* 15s *)
    step.
    (* just the first part of step *)
    eapply pimpl_ok2; eauto with prog.
    intros; norm; [cancel|].
    subst.
    (* we derive len = 0 before step creates several subgoals. *)
    assert (filelen f >= off + len).
    apply not_wlt_ge in H15.
    apply le_word_le_nat'; auto.
    assert (len = 0) by omega.
    subst len.
    intuition; eauto.
    instantiate (Fx0 := Fi).
    instantiate (olddata0 := nil).
    pred_apply; cancel.
    auto.

    time step.
    eapply pimpl_or_r; right; cancel; eauto.
    (* there are no zeroes, since we're appending nothing *)
    replace (off - filelen f) with 0 by omega.
    pred_apply; cancel.

    Grab Existential Variables.
    all: auto.
  Qed.

  Hint Extern 1 ({{_}} progseq (append _ _ _ _ _) _) => apply append_ok : prog.

End FASTBYTEFILE.


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^369 - 25
Base: 64
***)

Definition curve : CurveParameters :=
  {|
    sz := 6%nat;
    base := 64;
    bitwidth := 64;
    s := 2^369;
    c := [(1, 25)];
    carry_chains := None;

    a24 := None;
    coef_div_modulus := None;

    goldilocks := None;
    karatsuba := None;
    montgomery := true;
    freeze := Some false;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.


From Undecidability.L.Tactics Require Import LTactics GenEncode.
From Complexity.Complexity Require Export Definitions.
From Undecidability.L.Complexity Require Export UpToC UpToCNary.
From Complexity.Libs.CookPrelim Require Import Tactics.

(* Coq 8.11 or 8.10 changed lia so that it isn't able to deal with η conversion anymore; use this tactic to fix *)
Ltac simp_comp_arith := cbn -[Nat.add Nat.mul]; repeat change (fun x => ?h x) with h.

(** new definitions for UpToC *)
Notation c_of H := (@c__leUpToC _ _ _ (correct__UpToC (projT1 H))).

Tactic Notation "exists_const" ident(c):= match goal with  |- sigT  (fun (x : (UpToC ?E )) => _) => evar (c : nat); exists_UpToC (fun y => c * E y) end.

Ltac and_solve p := subst p; simp_comp_arith; try reflexivity; try lia.
Tactic Notation "exists_poly" ident(p) := evar (p : nat -> nat); exists p.
Tactic Notation "inst_const" := instantiate (1 := fun _ => _); cbn; reflexivity.
Ltac set_consts :=
  repeat match goal with
  |- context[(@c__leUpToC ?A ?B ?C (@correct__UpToC ?D ?E (@projT1 ?F ?G ?H)))] =>
      let c := fresh "C" in
      set (c := @c__leUpToC A B C (@correct__UpToC D E (@projT1 F G H)))
  end.

(* has the intuitive semantics of instantiate (c := c'); but tries to unfold local definitions in c' first in order to make this instantiation valid (c' itself has to be a local definition)*)
Ltac inst_with c c' :=
  repeat match goal with
  | c'' := ?h |- _ => constr_eq c' c'';
      match goal with
      | Ce := _ |- _ =>
          lazymatch h with context[Ce] =>
            assert_fails (constr_eq c' Ce); unfold Ce in c'
          end
      end
  end;
  match goal with
  | c'' := ?h |- _ => constr_eq c' c''; instantiate (c := h)
  end;
  try clear c';
  repeat match goal with
  | c0 := _ |- _ => try fold c0 in c
  end;
  subst c.
Tactic Notation "inst" ident(c) "with" constr(t) := let c' := fresh "c" in set (c' := t); inst_with c c'.

Record isPoly (X : Type) `{encodable X} (f : X -> nat) : Set :=
  {
    isP__poly : nat -> nat;
    isP__bounds : forall x, f x <= isP__poly (size (enc x));
    isP__inOPoly : inOPoly isP__poly;
    isP__mono : monotonic isP__poly;
  }.
Arguments isP__bounds {X} {H} {_} _.
Arguments isP__poly {X} {H} {_} _.

Smpl Add 15 apply isP__mono : inO.
Smpl Add 15 apply isP__inOPoly : inO.

Tactic Notation "rewpoly" constr(s) :=
  rewrite (isP__bounds s).
Tactic Notation "rewpoly" constr(s) "at" ne_integer_list(occ) :=
  rewrite (isP__bounds s) at occ.

Tactic Notation "monopoly" constr(H) "at" ne_integer_list(occ) :=
  setoid_rewrite (isP__mono H) at occ.
Tactic Notation "monopoly" constr(H) :=
  erewrite (isP__mono H).

Tactic Notation "replace_le" constr(s) "with" constr(r) "by" tactic(tac) :=
  let H := fresh in assert (s <= r) as H by tac; rewrite !H; clear H.
Tactic Notation "replace_le" constr(s) "with" constr(r) "by" tactic(tac) "at" ne_integer_list(occ) :=
  let H := fresh in assert (s <= r) as H by tac; rewrite H at occ; clear H.
Tactic Notation "replace_le" constr(s) "with" constr(r) :=
  let H := fresh in assert (s <= r) as H; [ | rewrite !H; clear H].

From Undecidability.L.Datatypes Require Import Lists LNat.
(** useful lemmas *)
#[export]
Instance proper_lt_mul : Proper (lt ==> eq ==> le) Nat.mul.
Proof.
  intros a b c d e f. nia.
Qed.

#[export]
Instance proper_lt_add : Proper (lt ==> eq ==> le) Nat.add.
Proof.
  intros a b c d e f. nia.
Qed.

#[export]
Instance proper_le_pow : Proper (le ==> eq ==> le) Nat.pow.
Proof.
  intros a b H1 d e ->. apply Nat.pow_le_mono_l, H1.
Qed.

#[export]
Instance mult_lt_le : Proper (eq ==> lt ==> le) mult.
Proof.
  intros a b -> d e H. nia.
Qed.

#[export]
Instance add_lt_lt : Proper (eq ==> lt ==> lt) Nat.add.
Proof.
  intros a b -> c d H. lia.
Qed.

#[export]
Instance le_lt_impl : Proper (le --> eq ==> Basics.impl) lt.
Proof.
  intros a b H d e ->. unfold Basics.flip in H. unfold Basics.impl. lia.
Qed.

#[export]
Instance lt_le_impl : Proper (lt --> eq ==> Basics.impl) le.
Proof.
  intros a b H d e ->. unfold Basics.flip in H. unfold Basics.impl. lia.
Qed.

Lemma list_el_size_bound {X : Type} `{encodable X} (l : list X) (a : X) :
  a el l -> size(enc a) <= size(enc l).
Proof.
  intros H1.
  rewrite size_list.
  induction l.
  - destruct H1.
  - cbn. destruct H1. rewrite H0; clear H0. solverec. rewrite IHl. 2: assumption.
    solverec.
Qed.

Definition maxSize {X : Type} `{encodable X} (l : list X) := maxl (map (fun x => size (enc x)) l).
Lemma maxSize_enc_size {X : Type} `{encodable X} (l : list X) : maxSize l<= size (enc l).
Proof.
  unfold maxSize. rewrite maxl_leq_l.
  2: { intros n (x & <- & Hel)%in_map_iff. apply list_el_size_bound, Hel. }
  easy.
Qed.

Lemma list_app_size {X : Type} `{encodable X} (l l' : list X) :
  size(enc (l ++ l')) + c__listsizeNil = size(enc l) + size(enc l').
Proof.
  repeat rewrite size_list.
  rewrite map_app. rewrite sumn_app. lia.
Qed.

Lemma list_size_at_least {X : Type} {H: encodable X} (l : list X) : size(enc l) >= c__listsizeNil.
Proof. rewrite size_list. lia. Qed.

Lemma list_app_size_l {X : Type} {H : encodable X} (l l' : list X) :
  size(enc (l ++ l')) >= size (enc l).
Proof.
  enough (size(enc (l++l')) + c__listsizeNil >= size(enc l) + c__listsizeNil) by lia.
  rewrite list_app_size. specialize (list_size_at_least l'). lia.
Qed.

Lemma list_app_size_r {X : Type} `{encodable X} (l l' : list X) :
  size(enc (l ++ l')) >= size (enc l').
Proof.
  enough (size(enc (l++l')) + c__listsizeNil >= size(enc l') + c__listsizeNil) by lia.
  rewrite list_app_size.  specialize (list_size_at_least l). lia.
Qed.

Require Import Complexity.Libs.CookPrelim.MorePrelim.
Lemma list_subsequence_size_bound {X : Type} `{encodable X} (l l': list X) :
  subsequence l l' -> size (enc l) <= size (enc l').
Proof.
  intros (C & D & ->).
  enough (size(enc l) <= size(enc (l++D))).
  {
    rewrite H0. specialize (list_app_size_r C (l++D)). lia.
  }
  specialize (list_app_size_l l D). lia.
Qed.

Lemma list_size_cons {X : Type} `{encodable X} (l : list X) (a : X) : size(enc (a::l)) = size(enc a) + size(enc l) + c__listsizeCons.
Proof. repeat rewrite size_list. cbn.  lia. Qed.

Lemma list_size_app (X : Type) (l1 l2 : list X) `{encodable X} : size (enc (l1 ++ l2)) <= size (enc l1) + size (enc l2).
Proof.
  rewrite <- list_app_size. lia.
Qed.

Lemma list_size_concat (X : Type) (l : list (list X)) `{encodable X} : size (enc (concat l)) <= size (enc l).
Proof.
  induction l; cbn; [easy | ].
  now rewrite list_size_app, list_size_cons, IHl.
Qed.

Lemma list_size_length {X : Type} `{encodable X} (l : list X) : |l| <= size(enc l).
Proof.
  rewrite size_list. induction l.
  - cbn; lia.
  - cbn. rewrite IHl. unfold c__listsizeCons; lia.
Qed.

Lemma list_size_enc_length {X : Type} `{encodable X} (l : list X) : size (enc (|l|)) <= size (enc l).
Proof.
  rewrite size_list. rewrite size_nat_enc. unfold c__natsizeS, c__natsizeO, c__listsizeNil, c__listsizeCons. induction l; cbn; lia.
Qed.

Lemma list_size_of_el {X : Type} `{encodable X} (l : list X) (k : nat) : (forall a, a el l -> size(enc a) <= k) -> size(enc l) <= (k * (|l|)) + c__listsizeCons * (|l|) +  c__listsizeNil .
Proof.
  intros H1. induction l.
  - cbn. rewrite size_list. cbn.  lia.
  - cbn -[c__listsizeCons]. rewrite list_size_cons. rewrite IHl; [ |now firstorder]. rewrite H1; [ |now left].
    solverec.
Qed.

Lemma map_time_mono (X : Type) (f1 f2 : X -> nat) (l : list X): (forall x : X, x el l -> f1 x <= f2 x) -> map_time f1 l <= map_time f2 l.
Proof.
  intros H. induction l; cbn; [lia | ].
  rewrite IHl, H by easy. lia.
Qed.

Lemma sumn_map_mono (X : Type) (f1 f2 : X -> nat) l : (forall x, x el l -> f1 x <= f2 x) -> sumn (map f1 l) <= sumn (map f2 l).
Proof.
  intros H. induction l; cbn; [lia | ].
  rewrite IHl, H by easy. lia.
Qed.

Lemma sumn_map_const (X : Type) c (l : list X) : sumn (map (fun _ => c) l) = |l| * c.
Proof.
  induction l; cbn; [lia | ].
  rewrite IHl. lia.
Qed.

Lemma nat_size_lt a b: a < b -> size (enc a) < size (enc b).
Proof.
  intros H. rewrite !size_nat_enc. unfold c__natsizeS; nia.
Qed.

Lemma nat_size_le a b: a <= b -> size (enc a) <= size (enc b).
Proof.
  intros H. rewrite !size_nat_enc. unfold c__natsizeS; nia.
Qed.

(* Lemma le_add_l n m : m <= n + m. *)
(* use Nat.le_add_l *)

(** Facts we need to prove that a small assignment has an encoding size which is polynomial in the CNF's encoding size *)
Lemma list_dupfree_incl_length (X : eqType) (a b : list X) : a <<= b -> dupfree a -> |a| <= |b|.
Proof.
  intros H1 H2. eapply NoDup_incl_length; assumption.
Qed.

Definition rem {X: eqType} := remove (@eqType_dec X).

Lemma list_rem_size_le (X : eqType) `{H : encodable X} (l : list X) x : size (enc (rem x l)) <= size (enc l).
Proof.
  induction l.
  - reflexivity.
  - cbn. destruct eqType_dec; cbn; rewrite !list_size_cons, IHl; lia.
Qed.

Lemma remove_cons {X} {dec: eq_dec X} (a: X) l: remove dec a (a :: l) = remove dec a l.
Proof.
  cbn. destruct (dec a a) as [|H].
  - reflexivity.
  - now contradiction H.
Qed.

Lemma list_incl_dupfree_size (X : eqType) `{encodable X} (a b : list X) : a <<= b -> dupfree a -> size (enc a) <= size (enc b).
Proof.
  intros H1 H2.  revert b H1.
  induction H2 as [ | a0 a H1 H2 IH]; intros.
  - cbn. rewrite !size_list. cbn. lia.
  - specialize (IH (rem a0 b)).
    rewrite list_size_cons.
    cbn. rewrite IH.
    2: {
      assert (rem a0 (a0 :: a) = a).
      { unfold rem. rewrite remove_cons. now apply notin_remove. }
      rewrite <- H3. now apply remove_incl.
    }
    specialize (H0 a0 (or_introl eq_refl)). apply In_explicit in H0 as (b1 & b2 & ->).
    unfold rem. rewrite !size_list, !remove_app, !map_app, !sumn_app. cbn.
    destruct (eqType_dec a0 a0) as [|E]; [|now contradiction E].
    pose (elem_size := fun (x : X) => size (enc x) + c__listsizeCons).
    fold elem_size.
    enough (sumn (map elem_size (rem a0 b1)) <= sumn (map elem_size b1) /\ sumn (map elem_size (rem a0 b2)) <= sumn (map elem_size b2)) as H0.
    { destruct H0 as [-> ->]. nia. }
    specialize (list_rem_size_le b1 a0) as F1.
    specialize (list_rem_size_le b2 a0) as F2.
    rewrite !size_list in F1. rewrite !size_list in F2.
    fold elem_size in F1. fold elem_size in F2.
    split; nia.
Qed.


(* -*- mode: coq; mode: visual-line -*-  *)

From HoTT Require Import Basics.
From WildCat Require Import Basics.
From WildCat Require Import Cat1.

Generalizable Variables m n p A B C.

(** * Forall (oo,n)-categories (with plain types as base) *)

(** ** Forall (oo,n)-categories *)

(** [forall] preserves globular types. *)
CoFixpoint isglob_forall `(B : A -> Type) `(forall a, IsGlob n (B a))
  : IsGlob n (forall a, B a).
Proof.
  exists (fun f g => forall a, f a $-> g a); intros.
  rapply isglob_forall.
Defined.

Global Existing Instance isglob_forall.

(** Postcomposing and precomposing between [forall] types preserves 0-coherent oo-functors.  (TODO: Should probably be generalized to sections.) *)
CoFixpoint isfunctor0_postcompose {m n A} (B C : A -> Type)
           `{forall a, IsGlob m (B a)} `{forall a, IsGlob n (C a)}
           (F : forall a, B a -> C a) `{!forall a, IsFunctor0 (F a)}
  : IsFunctor0 (fun f a => F a (f a)).
Proof.
  unshelve econstructor.
  - cbn; intros f g p a.
    exact (fmap (F a) (p a)).
  - intros; rapply isfunctor0_postcompose.
Defined.

CoFixpoint isfunctor0_precompose {n A B} (h : A -> B)
           (C : B -> Type) `{forall a, IsGlob n (C a)}
  : IsFunctor0 (fun f a => f (h a)).
Proof.
  unshelve econstructor.
  - cbn; intros f g p a.
    exact (p (h a)).
  - intros; rapply isfunctor0_precompose.
Defined.

Global Existing Instances isfunctor0_postcompose isfunctor0_precompose.

(** [forall] preserves 0-coherent oo-categories. *)
CoFixpoint iscat0_forall {n A} (B : A -> Type)
           {bg : forall a, IsGlob n (B a)} {bc : forall a, IsCat0 n (B a)}
  : IsCat0 n (forall a, B a).
Proof.
  unshelve econstructor; cbn.
  - intros f g h q p a; exact (q a $o p a).
  - intros f a; exact (cat_id (f a)).
  - intros; rapply isfunctor0_postcompose.
  - intros f g h p; rapply isfunctor0_postcompose.
  - intros ? f g p a. apply gpd_inv, p.
  - intros; rapply iscat0_forall.
Defined.

Global Existing Instance iscat0_forall.

(** A pointwise quasi-isomorphism in a [forall] is a quasi-isomorphism. *)
CoFixpoint isqiso_forall {n A} (B : A -> Type)
           {bg : forall a, IsGlob n (B a)} {bc : forall a, IsCat0 n (B a)}
           {f g : forall a, B a}
           (p : f $-> g) `{forall a, IsQIso (p a)}
  : IsQIso p.
Proof.
  unshelve econstructor.
  - exact (fun a => qiso_inv (p a)).
  - cbn; intros a. exact (qiso_issect (p a)).
  - cbn; intros a. exact (qiso_isretr (p a)).
  - rapply isqiso_forall. intros; exact (isqiso_qiso_issect (p a) _).
  - rapply isqiso_forall. intros; exact (isqiso_qiso_isretr (p a) _).
Defined.

(** And conversely. *)
CoFixpoint isqiso_from_forall {n A} (B : A -> Type)
           {bg : forall a, IsGlob n (B a)} {bc : forall a, IsCat0 n (B a)}
           {f g : forall a, B a}
           (p : f $-> g) `{!IsQIso p} (a : A)
  : IsQIso (p a).
Proof.
  unshelve econstructor.
  - exact (qiso_inv p a).
  - exact (qiso_issect p a).
  - exact (qiso_isretr p a).
  - exact (@isqiso_from_forall _ _ _ _ _ _ _ (qiso_issect p) (isqiso_qiso_issect p _) a).
  - exact (@isqiso_from_forall _ _ _ _ _ _ _ (qiso_isretr p) (isqiso_qiso_isretr p _) a).
Defined.

CoFixpoint hasequivs_forall {n A} (B : A -> Type)
           {bg : forall a, IsGlob n (B a)}
           {bc : forall a, IsCat0 n (B a)}
           {bh : forall a, HasEquivs n (B a)}
  : HasEquivs n (forall a, B a).
Proof.
  unshelve econstructor.
  - intros f g p; exact (forall a, CatIsEquiv (p a)).
  - intros f g p pe a; cbn.
    apply catie_isqiso; rapply isqiso_from_forall.
  - intros f g p pe; cbn.
    apply isqiso_forall; intros a.
    apply isqiso_catie, pe.
  - intros; rapply hasequivs_forall.
Defined.

Global Existing Instance hasequivs_forall.

Lemma Build_CatEquiv_forall {n A} (B : A -> Type)
  {bg : forall a, IsGlob n (B a)}
  {bc : forall a, IsCat0 n (B a)}
  {bh : forall a, HasEquivs n (B a)}
  : forall (f g : forall x, B x), (forall x, f x $<~> g x) -> f $<~> g.
Proof.
  intros f g e.
  snrapply Build_CatEquiv.
  { cbn; intros x.
    exact (e x). }
  unfold CatIsEquiv.
  unfold hasequivs_forall.
  cbn; intros a. (** intros and cbn struggling to work here without help. *)
  rapply catie_cate.
Defined.

(** Postcomposing and precomposing between [forall] types preserves 1-coherent oo-functors.  (TODO: Should probably be generalized to sections.) *)
CoFixpoint isfunctor1_postcompose {m n A} (B C : A -> Type)
  `{forall a, IsGlob m (B a), forall a, IsGlob n (C a)}
  `{!forall a, IsCat0 m (B a), !forall a, IsCat0 n (C a)}
  `{!forall a, HasEquivs m (B a), !forall a, HasEquivs n (C a)}
   (F : forall a, B a -> C a)
   `{!forall a, IsFunctor0 (F a), !forall a, IsFunctor1 (F a)}
  : IsFunctor1 (fun f a => F a (f a)).
Proof.
  snrapply Build_IsFunctor1.
  1: intros a.
  2: intros a b c f g.
  1,2: snrapply Build_CatEquiv_forall; intros x.
  1: exact (fmap_id _ (a x)).
  1: exact (fmap_comp _ (f x) (g x)).
  intros a b.
  rapply isfunctor1_postcompose.
Defined.

CoFixpoint isfunctor1_precompose {n A B} (h : A -> B) (C : B -> Type)
  `{forall a, IsGlob n (C a), !forall a, IsCat0 n (C a),
    !forall a, HasEquivs n (C a), !forall a, IsCat1 n (C a)}
  : IsFunctor1 (fun f a => f (h a)).
Proof.
  snrapply Build_IsFunctor1.
  1: intros a.
  2: intros a b c f g.
  1,2: snrapply Build_CatEquiv_forall; intros x.
  1: exact (fmap_id _ (a (h x))).
  1: exact (fmap_comp _ _ _).
  intros a b.
  rapply isfunctor1_precompose.
Defined.

Global Existing Instances isfunctor1_postcompose isfunctor1_precompose.

(** 1-coherent functors and categories *)
CoFixpoint is1cat_forall {n A} (B : A -> Type)
  {H1 : forall a, IsGlob n (B a)}
  {H2 : forall a, IsCat0 n (B a)}
  {H3 : forall a, HasEquivs n (B a)}
  {H4 : forall a, IsCat1 n (B a)}
  : IsCat1 n (forall a, B a).
Proof.
  constructor.
  1: intros a b c d f g h.
  2,3: intros a b f.
  4,5: intros isz a b f.
  1-5: snrapply Build_CatEquiv_forall; intros x.
  - rapply cat_assoc.
  - rapply cat_idl.
  - rapply cat_idr.
  - rapply gpd_issect.
  - rapply gpd_isretr.
  - intros a b c g; rapply isfunctor1_postcompose.
  - intros a b c f; rapply isfunctor1_postcompose.
  - intros a b; simpl.
    rapply is1cat_forall.
Defined.

(** ** Displayed forall (oo,n)-categories *)

(** Dependent [forall] preserves globular types. *)
CoFixpoint isdglob_forall
           {A : Type} (B : A -> Type) (C : forall a, B a -> Type)
           `(forall a, IsGlob m (B a)) `(forall a, IsDGlob n (C a))
  : IsDGlob n (fun (f:forall a, B a) => forall a, C a (f a)).
Proof.
  unshelve econstructor.
  - intros f g p u v.
    exact (forall a:A, DHom (p a) (u a) (v a)).
  - intros f g u v.
    rapply isdglob_forall.
Defined.

Global Existing Instance isdglob_forall.

(** Postcomposing and precomposing between dependent [forall] types preserves displayed 0-coherent oo-functors. *)
CoFixpoint isdfunctor0_postcompose {m n mm nn A} (B C : A -> Type)
           `{forall a, IsGlob m (B a)} `{forall a, IsGlob n (C a)}
           (BB : forall a, B a -> Type) (CC : forall a, C a -> Type)
           `{!forall a, IsDGlob mm (BB a)} `{!forall a, IsDGlob nn (CC a)}
           (F : forall a, B a -> C a) {Ff : forall a, IsFunctor0 (F a)}
           (FF : forall a b, BB a b -> CC a (F a b))
           {FFf : forall a, IsDFunctor0 (F a) (FF a)}
  : IsDFunctor0 (fun (f:forall a:A, B a) => (fun a:A => F a (f a)))
                (fun (f:forall a:A, B a) (g:forall a, BB a (f a))
                 => (fun a:A => FF a (f a) (g a))).
Proof.
  unshelve econstructor.
  - cbn; intros f g u v p q a.
    exact (dfmap (F a) (FF a) (q a)).
  - intros; rapply isdfunctor0_postcompose.
Defined.

CoFixpoint isdfunctor0_precompose {m n A B}
           (h : A -> B)
           (C : B -> Type) `{forall a, IsGlob m (C a)}
           (D : forall b:B, C b -> Type) `{forall a, IsDGlob n (D a)}
  : IsDFunctor0 (fun (f:forall b:B, C b) => (fun a => f (h a)))
                (fun (f:forall b:B, C b) (g:forall b, D b (f b))
                 => (fun a:A => g (h a))).
Proof.
  unshelve econstructor.
  - cbn; intros f g u v p q a.
    exact (q (h a)).
  - intros; rapply isdfunctor0_precompose.
Defined.

Global Existing Instances isdfunctor0_postcompose isdfunctor0_precompose.

(** Dependent [forall] preserves 0-coherent displayed oo-categories. *)
CoFixpoint isdcat0_forall
           {A : Type} (B : A -> Type) (C : forall a, B a -> Type)
           `(forall a, IsGlob m (B a)) `(forall a, IsCat0 m (B a))
           `(forall a, IsDGlob n (C a)) `(forall a, IsDCat0 n (C a))
  : IsDCat0 n (fun (f:forall a, B a) => forall a, C a (f a)).
Proof.
  unshelve econstructor; cbn.
  - intros f g h u v w q p s r a.
    exact (s a $oD r a).
  - intros f u a.
    exact (dcat_id (u a)).
  - intros; rapply isdfunctor0_postcompose.
  - intros; rapply isdfunctor0_postcompose.
  - intros ? f g u v p pe r a.
    pose (isqiso_from_forall B p a).
    exact (dgpd_inv (r a)).
  - intros; rapply isdcat0_forall.
Defined.

Global Existing Instance isdcat0_forall.