Set Warnings "-extraction-opaque-accessed,-extraction".
Set Warnings "-notation-overridden,-parsing".
Arith
Basics
List
Recdef
ZArith.
ssrbool
ssreflect
ssrnat.
Classes
GenLow
GenHigh
Sets.
GenLow
ListNotations
QcDefaultNotation.
Set Bullet Behavior "Strict Subproofs".
(** Basic generator instances *)
Global Instance genBoolSized : GenSized bool :=
{| arbitrarySized x := choose (false, true) |}.
Instance genNatSized : GenSized nat :=
{| arbitrarySized x := choose (0,x) |}.
Global Instance genZSized : GenSized Z :=
{| arbitrarySized x := let z := Z.of_nat x in
choose (-z, z)%Z |}.
Global Instance genNSized : GenSized N :=
{| arbitrarySized x := let n := N.of_nat x in
choose (N0, n) |}.
Global Instance genListSized {A : Type} `{GenSized A} : GenSized (list A) :=
{| arbitrarySized x := vectorOf x (arbitrarySized x) |}.
(* [3] is a lower priority than [Classes.GenOfGenSized], avoiding an infinite loop in typeclass resolution. *)
Global Instance genList {A : Type} `{Gen A} : Gen (list A) | 3 :=
{| arbitrary := listOf arbitrary |}.
Global Instance genOption {A : Type} `{Gen A} : Gen (option A) | 3 :=
{| arbitrary := freq [ (1, returnGen None)
; (7, liftGen Some arbitrary)] |}.
Global Instance genPairSized {A B : Type} `{GenSized A} `{GenSized B}
: GenSized (A*B) :=
{| arbitrarySized x :=
liftGen2 pair (arbitrarySized x)
(arbitrarySized x)
|}.
Global Instance genPair {A B : Type} `{Gen A} `{Gen B} : Gen (A * B) :=
{| arbitrary := liftGen2 pair arbitrary arbitrary |}.
(** Shrink Instances *)
Global Instance shrinkBool : Shrink bool :=
{| shrink x :=
match x with
| false => nil
| true  => cons false nil
end
|}.
(** Shrinking of nat starts to become annoying *)
Function shrinkNatAux (x : nat) {measure (fun x => x) x} : list nat :=
match x with
| O => nil
| S n =>
let x' := Nat.div x 2 in
x' :: shrinkNatAux x'
end.

Lemma neg_pred : forall p, (p > 1)%positive ->
Z.neg (Pos.pred p) = Z.succ (Z.neg p).