Set Warnings "-extraction-opaque-accessed,-extraction".
Set Warnings "-notation-overridden,-parsing".
Definition resultSuccessful (r : Result) : bool :=
match r with
| MkResult (Some res) expected _ _ _ _ _ =>
res == expected
| _ => true
end.
Definition successful qp :=
match qp with
| MkProp (MkRose res _) => resultSuccessful res
end.
(* Maps a Checker to a Prop *)
(* begin semCheckerSize *)
Definition semCheckerSize (c : Checker) (s : nat): Prop :=
successful @: semGenSize c s \subset [set true].
(* end semCheckerSize *)
(* ZP: Do we want to define semChecker in terms of semCheckerSize? *)
(* begin semChecker *)
Definition semChecker (c : Checker) : Prop := forall s, semCheckerSize c s.
(* end semChecker *)
(* Maps a Checkable to a Prop i.e. gives an equivalent proposition to the property under test *)
(* begin semCheckableSize *)
Definition semCheckableSize {A} `{Checkable A} (a : A) (s : nat) : Prop :=
semCheckerSize (checker a) s.
(* end semCheckableSize *)
(* begin semCheckable *)
Definition semCheckable {A} `{Checkable A} (a : A) : Prop := semChecker (checker a).
(* end semCheckable *)
Definition genChecker c := fmap successful c.
Class UnsizedChecker (c : Checker) :=
{
unsizedChecker :
forall s1 s2 : nat, semGenSize (genChecker c) s1 <--> semGenSize (genChecker c) s2
}.
Class SizeMonotonicChecker (c : Checker) :=
{
monotonicChecker :
forall s1 s2, s1 <= s2 ->
semGenSize (genChecker c) s1 \subset semGenSize (genChecker c) s2
}.
Program Instance unsizedMonotonicChecker (c : Checker) `{UnsizedChecker c} :
SizeMonotonicChecker c.
Next Obligation.
rewrite unsizedChecker. move => b Hb. by eauto.
Qed.
(* Program Instance shrinkingUnsized {C A} `{Checkable C} *)
(*         (sh : A -> list A) (x : A) (pf : A -> C)  *)
(*         `{UnsizedChecker (checker (pf x))} : UnsizedChecker (shrinking sh x pf). *)
(* Next Obligation.  *)
(* Abort. *)
Open Scope Checker_scope.

(* begin semImplication *)
Lemma semImplication {C} `{Checkable C} (c : C) (b : bool) :
semChecker (b ==> c) <-> (b -> semCheckable c).