Library SMTLIB.Domain
From Stdlib Require Import FunctionalExtensionality.
From SMTLIB Require Import Utils Symbols Term Signature Theory.
From SMTLIB.Theory Require Import Seq.
From SMTLIB Require Import Utils Symbols Term Signature Theory.
From SMTLIB.Theory Require Import Seq.
Building a Model's Domain
- domain (SApp s []) = base s, away from the datatypes;
- domain (τ_map σ1 σ2) = domain σ1 → domain σ2 (structure itself);
- domain (τ_seq σ) = list (domain σ) (SMTLIB.Theory.Seq);
- domain δ = seq_ground_term Σ (fun σ _ ⇒ domain σ) δ at every datatype sort (seq_adt_axioms).
The Two Passes
- adt_free_domain is the domain a signature with no datatypes would have, which is the correct one at every adt_free sort and a lie elsewhere;
- sort_domain is the real thing: the free algebra over adt_free_domain at a datatype sort, and adt_free_domain's own clauses elsewhere.
base is total in the sort symbol rather than restricted to Σ's own,
because a sort is a symbol applied to arguments and nothing here knows
which symbols are declared. At a symbol the caller does not care about,
any inhabited type will do.
Pass one. Structural in the sort, and blind to the signature: the point
is that it can be defined before any datatype's domain is. A datatype
sort is nullary here like any other, so it lands on base, which is the
deliberate lie sort_domain overrides.
Fixpoint adt_free_domain (σ : sort) : Type :=
match σ with
| SParam _ ⇒ unit
| SApp s [] ⇒ base s
| SApp s [σ1] ⇒
if decide (s = s_seq) then list (adt_free_domain σ1) else unit
| SApp s [σ1; σ2] ⇒
if decide (s = s_map)
then (adt_free_domain σ1 → adt_free_domain σ2)
else unit
| SApp _ _ ⇒ unit
end.
match σ with
| SParam _ ⇒ unit
| SApp s [] ⇒ base s
| SApp s [σ1] ⇒
if decide (s = s_seq) then list (adt_free_domain σ1) else unit
| SApp s [σ1; σ2] ⇒
if decide (s = s_map)
then (adt_free_domain σ1 → adt_free_domain σ2)
else unit
| SApp _ _ ⇒ unit
end.
Pass two. The datatype test comes first, so the equation it owes holds
by decide_True alone; every other equation owes a proof that its sort
is not a datatype, which is a condition on Σ and the caller's to
discharge.
Fixpoint sort_domain (σ : sort) : Type :=
if decide (adt Σ σ)
then seq_ground_term Σ (fun τ _ ⇒ adt_free_domain τ) σ
else
match σ with
| SParam _ ⇒ unit
| SApp s [] ⇒ base s
| SApp s [σ1] ⇒
if decide (s = s_seq) then list (sort_domain σ1) else unit
| SApp s [σ1; σ2] ⇒
if decide (s = s_map)
then (sort_domain σ1 → sort_domain σ2)
else unit
| SApp _ _ ⇒ unit
end.
if decide (adt Σ σ)
then seq_ground_term Σ (fun τ _ ⇒ adt_free_domain τ) σ
else
match σ with
| SParam _ ⇒ unit
| SApp s [] ⇒ base s
| SApp s [σ1] ⇒
if decide (s = s_seq) then list (sort_domain σ1) else unit
| SApp s [σ1; σ2] ⇒
if decide (s = s_map)
then (sort_domain σ1 → sort_domain σ2)
else unit
| SApp _ _ ⇒ unit
end.
The Agreement
Lemma sort_domain_adt_free : ∀ σ,
adt_free Σ σ → sort_domain σ = adt_free_domain σ.
Proof.
induction σ as [u | s τs IH]; intros Hf.
- cbn [sort_domain adt_free_domain].
rewrite decide_False by (by apply adt_free_not_adt). reflexivity.
- apply adt_free_app_inv in Hf as [Hnadt Hτs].
cbn [sort_domain adt_free_domain].
rewrite decide_False by (unfold adt; congruence).
destruct τs as [| σ1 [| σ2 τs']]; try reflexivity.
+ case_decide; [| reflexivity]. f_equal.
apply IH; [set_solver | by inversion Hτs].
+ case_decide; [| reflexivity].
inversion Hτs as [| ? ? Hσ1 Hτs']; subst.
inversion Hτs' as [| ? ? Hσ2 _]; subst.
rewrite (IH σ1) by (first [set_solver | exact Hσ1]).
rewrite (IH σ2) by (first [set_solver | exact Hσ2]).
reflexivity.
Qed.
adt_free Σ σ → sort_domain σ = adt_free_domain σ.
Proof.
induction σ as [u | s τs IH]; intros Hf.
- cbn [sort_domain adt_free_domain].
rewrite decide_False by (by apply adt_free_not_adt). reflexivity.
- apply adt_free_app_inv in Hf as [Hnadt Hτs].
cbn [sort_domain adt_free_domain].
rewrite decide_False by (unfold adt; congruence).
destruct τs as [| σ1 [| σ2 τs']]; try reflexivity.
+ case_decide; [| reflexivity]. f_equal.
apply IH; [set_solver | by inversion Hτs].
+ case_decide; [| reflexivity].
inversion Hτs as [| ? ? Hσ1 Hτs']; subst.
inversion Hτs' as [| ? ? Hσ2 _]; subst.
rewrite (IH σ1) by (first [set_solver | exact Hσ1]).
rewrite (IH σ2) by (first [set_solver | exact Hσ2]).
reflexivity.
Qed.
The Equations
Lemma sort_domain_base : ∀ s,
¬ adt Σ (SApp s []) → sort_domain (SApp s []) = base s.
Proof.
intros s H. cbn [sort_domain]. by rewrite decide_False.
Qed.
Lemma sort_domain_τ_map : ∀ σ1 σ2,
¬ adt Σ (τ_map σ1 σ2) →
sort_domain (τ_map σ1 σ2) = (sort_domain σ1 → sort_domain σ2).
Proof.
intros σ1 σ2 H. unfold τ_map in ×. cbn [sort_domain].
rewrite decide_False by exact H. by rewrite decide_True.
Qed.
Lemma sort_domain_τ_seq : ∀ σ,
¬ adt Σ (τ_seq σ) → sort_domain (τ_seq σ) = list (sort_domain σ).
Proof.
intros σ H. unfold τ_seq in ×. cbn [sort_domain].
rewrite decide_False by exact H. by rewrite decide_True.
Qed.
The datatype equation. sort_domain is the free algebra over
adt_free_domain by definition; what has to be shown is that reading it
as the algebra over sort_domain gives the *same type*, and that is an
equality of the two generator parameters, by functional extensionality
twice — once for the sort, once for the generator_sort proof the
parameter is indexed by. sort_domain_adt_free is what makes the bodies
equal, and it applies because the index is exactly a proof that the sort
is datatype-free.
Lemma sort_domain_adt : ∀ δ,
adt Σ δ → sort_domain δ = seq_ground_term Σ (fun σ _ ⇒ sort_domain σ) δ.
Proof.
intros δ H. destruct δ; cbn [sort_domain]; rewrite decide_True by exact H;
f_equal; apply functional_extensionality_dep; intros σ;
apply functional_extensionality_dep; intros [Hfree _];
symmetry; by apply sort_domain_adt_free.
Qed.
adt Σ δ → sort_domain δ = seq_ground_term Σ (fun σ _ ⇒ sort_domain σ) δ.
Proof.
intros δ H. destruct δ; cbn [sort_domain]; rewrite decide_True by exact H;
f_equal; apply functional_extensionality_dep; intros σ;
apply functional_extensionality_dep; intros [Hfree _];
symmetry; by apply sort_domain_adt_free.
Qed.
Inhabitation
Context (base_witness : ∀ s, base s).
Definition adt_free_domain_witness : ∀ σ, adt_free_domain σ.
Proof.
induction σ as [u | s τs IH] using sort_rect.
- exact tt.
- destruct τs as [| σ1 [| σ2 [| σ3 τs']]]; cbn [adt_free_domain].
+ exact (base_witness s).
+ case_decide; [exact [] | exact tt].
+ case_decide; [intros _; apply IH; set_solver | exact tt].
+ exact tt.
Defined.
At a datatype sort it is not free, and the obligation does not reduce
further: the free algebra at δ is empty unless some constructor of δ
has every field sort inhabited, which is a well-foundedness condition on
the datatype declarations rather than anything this construction can
supply. It is taken as a parameter and owed by whoever builds Σ.
Definition sort_domain_witness
(w : ∀ δ, adt Σ δ →
seq_ground_term Σ (fun τ _ ⇒ adt_free_domain τ) δ)
: ∀ σ, sort_domain σ.
Proof.
induction σ as [u | s τs IH] using sort_rect; cbn [sort_domain].
- destruct (decide (adt Σ (SParam u))) as [Ha | Ha];
[exact (w _ Ha) | exact tt].
- destruct (decide (adt Σ (SApp s τs))) as [Ha | Ha]; [exact (w _ Ha) |].
destruct τs as [| σ1 [| σ2 [| σ3 τs']]]; cbn [sort_domain].
+ exact (base_witness s).
+ case_decide; [exact [] | exact tt].
+ case_decide; [intros _; apply IH; set_solver | exact tt].
+ exact tt.
Defined.
End DomainConstruction.
(w : ∀ δ, adt Σ δ →
seq_ground_term Σ (fun τ _ ⇒ adt_free_domain τ) δ)
: ∀ σ, sort_domain σ.
Proof.
induction σ as [u | s τs IH] using sort_rect; cbn [sort_domain].
- destruct (decide (adt Σ (SParam u))) as [Ha | Ha];
[exact (w _ Ha) | exact tt].
- destruct (decide (adt Σ (SApp s τs))) as [Ha | Ha]; [exact (w _ Ha) |].
destruct τs as [| σ1 [| σ2 [| σ3 τs']]]; cbn [sort_domain].
+ exact (base_witness s).
+ case_decide; [exact [] | exact tt].
+ case_decide; [intros _; apply IH; set_solver | exact tt].
+ exact tt.
Defined.
End DomainConstruction.