Set Warnings "-extraction-opaque-accessed,-extraction".
Set Warnings "-notation-overridden,-parsing".
Set Bullet Behavior "Strict Subproofs".
(** Apply a function n times *)
Fixpoint appn {A} (f : A -> A) (n : nat) : A ->  A :=
fun x =>
match n with
| 0%nat => x
| S n' => f (appn f n' x)
end.
Infix "^" := appn (at level 30, right associativity) : fun_scope.
(** Instance Hierarchy  GenSized | | Gen   Shrink \    / \  / Arbitrary *)
(** * Generator-related classes *)
(* begin gen_sized_class *)
Class GenSized (A : Type) := { arbitrarySized : nat -> G A }.
(* end gen_sized_class *)
(* begin gen_class *)
Class Gen (A : Type) := { arbitrary : G A }.
(* end gen_class *)
(** Shrink class *)
Class Shrink (A : Type) :=
{ shrink : A -> list A }.
(** Arbitrary Class *)
Class Arbitrary (A : Type) `{Gen A} `{Shrink A}.
(** * Sizes of types *)
Class Sized (A : Type) :=
{ size : A -> nat }.
Class CanonicalSized (A : Type) `{Sized A} :=
{
zeroSized : set A;
succSized : set A -> set A;
zeroSized_spec : zeroSized <--> [ set x : A | size x = 0 ];
succSized_spec :
forall n, succSized [ set x : A | size x <= n ] <--> [ set x : A | size x <= S n ]
}.
(* Lemma succ_lfp' (A : Type) `{Hyp : CanonicalSized A} : *)
(*   \bigcup_(s : nat)  (succSized ^ s) zeroSized <--> [ set x : A | True ]. *)
(* Proof. *)
(*   intros. split; eauto. *)
(*   intros _. *)
(*   eapply set_eq_trans. *)
(*   Focus 2. symmetry. *)
(*   eapply succ_lfp. *)
(*   simpl.  *)
(*   rewrite succ_lfp at 2. *)
(* split. *)
(*     split. rewrite IHs. firstorder. *)
(*     IHs. *)
(*   firstorder. reflexivity. split; intros; eauto. *)
(*   exists (size a). *)
(*   remember (size a) as s. *)
(*   revert a Heqs. induction s; intros. *)
(*   - split. constructor. *)
(*     simpl. eapply zeroSized_spec. now eauto. *)
(*   - split. constructor. *)
(*     simpl. *)
(*     eapply (succSized_spec. *)
(*     eassumption. *)
(*   eapply size_ind. *)
(*   [set x : A | True ] <-->  . *)
(** * Correctness classes *)
(** Correctness of sized generators *)
Class SizedCorrect {A : Type} `{Sized A} (g : nat -> G A) :=
{
arbitrarySizedCorrect : forall s, semGen (g s) <--> [set x : A | size x <= s ]
}.
(** Correctness of generators *)
Class Correct (A : Type) (g : G A)  :=
{
arbitraryCorrect : semGen g <--> [set : A]
}.
(** * Monotonic generators *)
(** Monotonicity of size parametric generators *)
Class GenSizedMonotonic (A : Type) `{GenSized A}
`{forall s, SizeMonotonic (arbitrarySized s)}.
(** Monotonicity of size parametric generators v2 *)
Class GenSizedSizeMonotonic (A : Type) `{GenSized A} `{SizedMonotonic A arbitrarySized}.
Class GenMonotonic (A : Type) `{Gen A} `{SizeMonotonic A arbitrary}.
(** * Correct generators *)
Class GenSizedCorrect (A : Type) `{GenSized A} `{SizedCorrect A arbitrarySized}.
Class GenCorrect (A : Type) `{Gen A} `{Correct A arbitrary}.
(* Monotonic and Correct generators *)
Class GenMonotonicCorrect (A : Type)
`{Gen A} `{SizeMonotonic A arbitrary} `{Correct A arbitrary}.
(** Coercions *)
Instance GenSizedMonotonicOfSizeMonotonic
(A : Type) (Hgen : GenSized A) (Hmon : forall s, @SizeMonotonic A (arbitrarySized s))
: @GenSizedMonotonic A Hgen Hmon := {}.
Instance GenMonotonicOfSizeMonotonic
(A : Type) (Hgen : Gen A) (Hmon : @SizeMonotonic A arbitrary)
: @GenMonotonic A Hgen Hmon := {}.
Instance GenSizedCorrectOfSizedCorrect
(A : Type) (Hgen : GenSized A) `{Hcor : SizedCorrect A arbitrarySized}
: @GenSizedCorrect A Hgen _ Hcor := {}.
Instance GenCorrectOfCorrect
(A : Type) (Hgen : Gen A) `{Hcor : Correct A arbitrary}
: @GenCorrect A Hgen Hcor := {}.
Instance GenSizedSizeMonotonicOfSizedMonotonic
(A : Type) (Hgen : GenSized A) (Hmon : @SizedMonotonic A arbitrarySized)
: @GenSizedSizeMonotonic A Hgen Hmon := {}.
(* Zoe : Is global really needed here? *)
Global Instance GenOfGenSized {A} `{GenSized A} : Gen A :=
{| arbitrary := sized arbitrarySized |}.
Global Instance ArbitraryOfGenShrink {A} `{Gen A} `{Shrink A} : Arbitrary A := {}.
Generalizable Variables PSized PMon PSMon PCorr.
Instance GenMonotonicOfSized (A : Type)
{H : GenSized A}
`{@GenSizedMonotonic A H PMon}
`{@GenSizedSizeMonotonic A H PSMon}
: GenMonotonic A := {}.
Instance GenCorrectOfSized (A : Type)
{H : GenSized A}
`{@GenSizedMonotonic A H PMon}
`{@GenSizedSizeMonotonic A H PSMon}
`{@GenSizedCorrect A H PSized PCorr} : Correct A arbitrary.

Lemma nat_set_ind (A : Type) `{GenSized A} `{Hyp : CanonicalSized A} :
(semGen (arbitrarySized 0) <--> zeroSized) ->
(forall (s : nat) (elems : set A),
semGen (arbitrarySized s) <--> elems ->
semGen (arbitrarySized (s.+1)) <--> succSized elems) ->
(forall s : nat, semGen (arbitrarySized s) <--> (fun x : A => size x <= s)).