(* QuickChick Prelude *)
Set Warnings "-extraction-opaque-accessed,-extraction".
Set Warnings "-notation-overridden,-parsing".
Set Bullet Behavior "Strict Subproofs".
(* End prelude *)
Hint Constructors multi.
Inductive tm : Type :=
| ttrue : tm
| tfalse : tm
| tif : tm -> tm -> tm -> tm
| tzero : tm
| tsucc : tm -> tm
| tpred : tm -> tm
| tiszero : tm -> tm.
Derive (Arbitrary, Show) for tm.
Derive (Sized, CanonicalSized) for tm.
Derive SizeMonotonic for tm using genStm0.
Derive SizedMonotonic for tm.
Derive SizedCorrect for tm using genStm0 and SizeMonotonictm.
Instance eq_dec_tm (t1 t2 : tm) : Dec (t1 = t2).
constructor; unfold decidable; repeat decide equality. Defined.
Inductive bvalue : tm -> Prop :=
| bv_true : bvalue ttrue
| bv_false : bvalue tfalse.
Derive ArbitrarySizedSuchThat for (fun tm => bvalue tm).
Derive SizedProofEqs for (fun tm => bvalue tm).
Derive SizeMonotonicSuchThatOpt for (fun tm => bvalue tm).
Derive GenSizedSuchThatCorrect for (fun tm => bvalue tm).
Derive GenSizedSuchThatSizeMonotonicOpt for (fun tm => bvalue tm).
Instance dec_bvalue t : Dec (bvalue t) :=
{| dec := _ |}.
induction t;
try solve [right => contra; inversion contra];
try solve [left; constructor].
Defined.
Inductive nvalue : tm -> Prop :=
| nv_zero : nvalue tzero
| nv_succ : forall t, nvalue t -> nvalue (tsucc t).
Instance dec_nvalue t : Dec (nvalue t) :=
{| dec := _ |}.
induction t;
try solve[right => contra; inversion contra].
- left; constructor.
- destruct IHt as [L | R]; [left; constructor | right => contra; inversion contra]; eauto.
Defined.
Derive ArbitrarySizedSuchThat for (fun tm => nvalue tm).
Derive SizedProofEqs for (fun tm => nvalue tm).
Derive SizeMonotonicSuchThatOpt for (fun tm => nvalue tm).
Derive GenSizedSuchThatCorrect for (fun tm => nvalue tm).
Derive GenSizedSuchThatSizeMonotonicOpt for (fun tm => nvalue tm).
Definition value (t:tm) := bvalue t \/ nvalue t.
Hint Constructors bvalue nvalue.
Hint Unfold value.
Hint Unfold update.
Reserved Notation "t1 '===>' t2" (at level 40).
Inductive step : tm -> tm -> Prop :=
| ST_IfTrue : forall t1 t2,
(tif ttrue t1 t2) ===> t1
| ST_IfFalse : forall t1 t2,
(tif tfalse t1 t2) ===> t2
| ST_If : forall t1 t1' t2 t3,
t1 ===> t1' ->
(tif t1 t2 t3) ===> (tif t1' t2 t3)
| ST_Succ : forall t1 t1',
t1 ===> t1' ->
(tsucc t1) ===> (tsucc t1')
| ST_PredZero :
(tpred tzero) ===> tzero
| ST_PredSucc : forall t1,
nvalue t1 ->
(tpred (tsucc t1)) ===> t1
| ST_Pred : forall t1 t1',
t1 ===> t1' ->
(tpred t1) ===> (tpred t1')
| ST_IszeroZero :
(tiszero tzero) ===> ttrue
| ST_IszeroSucc : forall t1,
nvalue t1 ->
(tiszero (tsucc t1)) ===> tfalse
| ST_Iszero : forall t1 t1',
t1 ===> t1' ->
(tiszero t1) ===> (tiszero t1')
where "t1 '===>' t2" := (step t1 t2).
Hint Constructors step.
Derive ArbitrarySizedSuchThat for (fun tm => step tm0 tm).
Derive SizeMonotonicSuchThatOpt for (fun tm => step tm0 tm).
Derive GenSizedSuchThatSizeMonotonicOpt for (fun tm => step tm0 tm).
(* QuickChickDebug Debug On. *)
Derive SizedProofEqs for (fun tm => step tm0 tm).
(* Zoe: SizedProofEqs -- works but takes forever *)
Derive GenSizedSuchThatCorrect for (fun tm => step tm0 tm).
Definition success := "Proofs work!".
Print success.
Instance step_gen_correct t0 : SuchThatCorrect (fun t => step t0 t)
(@arbitraryST _ (fun t => step t0 t) _).
Admitted.
Notation step_normal_form := (normal_form step).
Definition stuck (t:tm) : Prop :=
step_normal_form t /\ ~ value t.
Hint Unfold stuck.
(* xistential rework - dummy step *)
Definition step_fun (t : tm) : option tm := Some t.

(* Specifications: *)
Axiom step_fun_correct : forall t t',
step_fun t = Some t' <-> step t t'.