(* QuickChick Prelude *)
Set Warnings "-extraction-opaque-accessed,-extraction".
Set Warnings "-notation-overridden,-parsing".
Set Bullet Behavior "Strict Subproofs".
(* End prelude *)
Derive (Arbitrary, Show) for ascii.
Derive (Sized, CanonicalSized) for ascii.
Derive SizeMonotonic for ascii using genSascii.
Derive SizedMonotonic for ascii using genSascii.
Derive SizedCorrect for ascii using genSascii and SizeMonotonicascii.
Derive (Arbitrary, Show) for string.
Derive (Sized, CanonicalSized) for string.
Derive SizeMonotonic for string using genSstring.
Derive SizedMonotonic for string.
Derive SizedCorrect for string using genSstring and SizeMonotonicstring.
Inductive id : Type :=
| Id : string -> id.
Derive (Arbitrary, Show) for id.
Derive (Sized, CanonicalSized) for id.
Derive SizeMonotonic for id using genSid.
Derive SizedMonotonic for id.
Derive SizedCorrect for id using genSid and SizeMonotonicid.
Instance eq_dec_id (x y : id) : Dec (x = y).
constructor; unfold decidable. repeat decide equality. Defined.
Definition beq_id x y :=
match x,y with
| Id n1, Id n2 => if string_dec n1 n2 then true else false
end.
Admitted. (* QuickChick beq_id_refl. *)
Admitted. (* Prop *)
Admitted. (* Prop *)
Admitted. (* QuickChick false_beq_id. *)
(* Maps as functions are bad, explicit maps instead *)
Definition partial_map := list (id * nat).
Definition empty : partial_map := nil.
Definition update := @cons (id * nat).
Inductive bind : partial_map -> id -> nat -> Prop :=
| BindNow   : forall x a m, bind (cons (x, a) m) x a
| BindLater : forall x x' a a' m',
~ (x = x') ->
bind m' x a ->
bind (cons (x',a') m') x a.
Derive ArbitrarySizedSuchThat for (fun x => bind m x a).
Derive SizeMonotonicSuchThatOpt for (fun x => bind m x a).
Derive GenSizedSuchThatSizeMonotonicOpt for (fun x => bind m x a).
(* KNOWN DUG. The derivation of SizedProofEqs for bind fails. *)
(* Derive SizedProofEqs for (fun x => bind m x a). *)
(* Derive GenSizedSuchThatCorrect for (fun x => bind m x a). *)
Instance adm_st m a : SuchThatCorrect (fun x => bind m x a) (genST (fun x => bind m x a)).
Admitted.
Instance checkFalse : Checkable False := {| checker := fun _ => checker false |}.
Instance bind_dec m x v : Dec (bind m x v) :=
{| dec := _ |}.
Admitted. (* QuickChick update_shadow. *)
Admitted. (* QuickChick update_same. *)
Admitted. (* QuickChick update_permute. *)
Definition total_map := (partial_map * nat)%type.
Definition t_empty v : total_map := (empty, v).
Definition t_update (m : total_map) (x : id) (v : nat) :=
let (pm,d) := m in
(update (x, v) pm, d).
Inductive t_bind : partial_map -> nat -> id -> nat -> Prop :=
| T_BindDef   : forall x v, t_bind nil v x v
| T_BindNow   : forall x a m d, t_bind (cons (x, a) m) d x a
| T_BindLater : forall x x' a a' m' d,
~ (x = x') ->
t_bind m' d x a ->
t_bind (cons (x',a') m') d x a.
Derive ArbitrarySizedSuchThat for (fun x => t_bind m d x a).
Derive SizeMonotonicSuchThatOpt for (fun x => t_bind m d x a).
Instance adm_st' d m a : SuchThatCorrect (fun x => t_bind m d x a) (genST (fun x => t_bind m d x a)).
Admitted.
Admitted. (* Leo TODO: suchtat4_2  QuickChick t_apply_empty. *)
Fixpoint lookup m x : option nat :=
match m with
| nil => None
| (x',v)::t => if (x = x') ? then Some v else lookup t x
end.
Definition t_lookup (m : total_map) x :=
let (m, d) := m in
match lookup m x with
| Some v => v
| None => d
end.

Lemma t_update_eq : forall (m: total_map) x v,
t_lookup (t_update m x v) x = v.