Function shrinkZAux (x : Z) {measure (fun x => Z.abs_nat x) x}: list Z :=
match x with
| Z0 => nil
| Zpos _ => rev (cons (Z.pred x) (cons (Z.div2 x) (shrinkZAux (Z.div2 x))))
| Zneg _ => rev (cons (Z.succ x) (cons (Z.succ (Z.div2 x)) (shrinkZAux (Z.succ (Z.div2 x)))))
end.
Global Instance shrinkZ : Shrink Z :=
{| shrink := shrinkZAux |}.
Open Scope program_scope.
Global Instance shrinkN : Shrink N :=
{| shrink := map Z.to_N ∘ shrink ∘ Z.of_N |}.
Fixpoint shrinkListAux {A : Type} (shr : A -> list A) (l : list A) : list (list A) :=
match l with
| nil => nil
| cons x xs =>
cons xs (map (fun xs' => cons x xs') (shrinkListAux shr xs))
++ (map (fun x'  => cons x' xs) (shr x ))
end.
Global Instance shrinkList {A : Type} `{Shrink A} : Shrink (list A) :=
{| shrink := shrinkListAux shrink |}.
Global Instance shrinkPair {A B} `{Shrink A} `{Shrink B} : Shrink (A * B) :=
{|
shrink := fun (p : A * B) =>
let (a,b) := p in
map (fun a' => (a',b)) (shrink a) ++ map (fun b' => (a,b')) (shrink b)
|}.
Global Instance shrinkOption {A : Type} `{Shrink A} : Shrink (option A) :=
{| shrink m :=
match m with
| None => []
| Some x => None :: (map Some (shrink x))
end
|}.
(** Arbitraries are derived automatically! *)
(** Instance correctness *)
Program Instance arbNatMon : SizeMonotonic (@arbitrary nat _).
Next Obligation.
rewrite !semSizedSize !semChooseSize // => n /andP [/leP H1 /leP H2].
move : H => /leP => Hle. apply/andP. split; apply/leP; omega.
Qed.
(** Correctness proof about built-in generators *)
Instance boolSizeMonotonic : SizeMonotonic (@arbitrary bool _).
Instance boolSizedMonotonic : SizedMonotonic (@arbitrarySized bool _).
Instance boolCorrect : Correct bool arbitrary.

(* Specifications: *)
Lemma arbBool_correct:
semGen arbitrary <--> [set: bool].
Lemma arbNat_correct:
semGen arbitrary <--> [set: nat].