Danila Fedorin
2ee32580a2
The fable-based migration left a two-layer design (a standalone `FixedHeight α h` struct, height carried as a type index, plus a `FiniteHeightLattice` wrapper). This collapses it to the single `FiniteHeightLattice` typeclass (height as a plain field, `⊥`/`⊤` via `extends Bot`/`Top`), and fixes the fallout so the whole project builds again (`lake build` green). - Lattice: repair `FixedHeight.bot_le` (compute the `▸` motive via a forward `rw`, drop the leftover `fh.length_longestChain`) and the `bot_le` alias. - Isomorphism: transport rewritten directly onto `FiniteHeightLattice`, taking the source as an instance argument. - Lattice/Prod, AboveBelow: `FixedHeight`-producing def + wrapper instance collapsed into one `FiniteHeightLattice` instance. `head`/`last` proofs use term-mode `congrArg` to bridge the `Bot`/`Top` defeq through the under-construction instance projection (where `rw`+`rfl` cannot). - Lattice/IterProd: `fixedHeight` recursion now yields a `FiniteHeightLattice` (no height index, so the `.cast (by ring)` reassociations vanish); `bot_fixedHeight` reprojected onto the def's own `.bot`. - Lattice/FiniteMap: `fixedHeight`/`bot_contains_bots` go through transport with the IterProd instance resolved by typeclass search; `punitFixedHeight` replaced by the `PUnit` instance. - Analysis/Forward/Lattices: `botV` uses `⊥` instead of the deleted `FiniteHeightLattice.bot` accessor. - Analysis/Sign: `num` case used unimported `ring`; the goal is a pure ℕ→ℤ cast identity, closed with `norm_cast`. Also fixes the missing `show` in `AboveBelow.monotone₂_of_strict` that left un-beta-reduced redexes. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
144 lines
5.6 KiB
Lean4
144 lines
5.6 KiB
Lean4
/-
|
||
Port of `Analysis/Forward/Lattices.agda`.
|
||
|
||
The Agda module instantiates `Lattice.FiniteMap` twice (variables ↦ abstract
|
||
values, states ↦ variable maps) and re-exports everything with ᵛ/ᵐ suffixes.
|
||
In Lean the two instantiations are `abbrev`s and the FiniteMap API is used
|
||
directly; the module parameters (the finite-height lattice `L`, the program)
|
||
become section variables, with the finite-height structure and the lattice
|
||
interpretation arriving by instance resolution as in Agda.
|
||
|
||
Correspondence:
|
||
VariableValues, StateVariables ↦ VariableValues, StateVariables
|
||
isLatticeᵛ/isLatticeᵐ, ⊔ᵛ, ≼ᵛ … ↦ (the FiniteMap Lattice instances)
|
||
fixedHeightᵛ, fixedHeightᵐ ↦ (the FiniteMap FiniteHeightLattice instance)
|
||
⊥ᵛ, ⊥ᵛ-contains-bottoms ↦ botV, FiniteMap.bot_contains_bots
|
||
states-in-Map ↦ states_memKey
|
||
variablesAt ↦ variablesAt
|
||
variablesAt-∈ ↦ variablesAt_mem
|
||
variablesAt-≈ ↦ (congruence, trivial with `=`)
|
||
joinForKey, joinForKey-Mono ↦ joinForKey, joinForKey_mono
|
||
joinAll, joinAll-Mono,
|
||
joinAll-k∈ks-≡ ↦ joinAll, joinAll_mono, joinAll_mem_eq
|
||
variablesAt-joinAll ↦ variablesAt_joinAll
|
||
⟦_⟧ᵛ ↦ interpV
|
||
⟦⊥ᵛ⟧ᵛ∅ ↦ interpV_botV_nil
|
||
⟦⟧ᵛ-respects-≈ᵛ ↦ (trivial with `=`)
|
||
⟦⟧ᵛ-⊔ᵛ-∨ ↦ interpV_sup
|
||
⟦⟧ᵛ-foldr ↦ interpV_foldr
|
||
-/
|
||
import Spa.Language
|
||
import Spa.Lattice.FiniteMap
|
||
|
||
namespace Spa
|
||
|
||
variable (L : Type) [Lattice L] (prog : Program)
|
||
|
||
/-- Agda: `VariableValues`. -/
|
||
abbrev VariableValues : Type := FiniteMap String L prog.vars
|
||
|
||
/-- Agda: `StateVariables`. -/
|
||
abbrev StateVariables : Type := FiniteMap prog.State (VariableValues L prog) prog.states
|
||
|
||
/-- Agda: `⊥ᵛ` (the bottom of `fixedHeightᵛ`, now found by instance search). -/
|
||
def botV [FiniteHeightLattice L] : VariableValues L prog :=
|
||
(⊥ : VariableValues L prog)
|
||
|
||
variable {L prog}
|
||
|
||
omit [Lattice L] in
|
||
/-- Agda: `states-in-Map`. -/
|
||
theorem states_memKey (s : prog.State) (sv : StateVariables L prog) :
|
||
FiniteMap.MemKey s sv :=
|
||
FiniteMap.memKey_iff.mpr (prog.states_complete s)
|
||
|
||
/-- Agda: `variablesAt`. -/
|
||
def variablesAt (s : prog.State) (sv : StateVariables L prog) :
|
||
VariableValues L prog :=
|
||
(FiniteMap.locate (states_memKey s sv)).1
|
||
|
||
omit [Lattice L] in
|
||
/-- Agda: `variablesAt-∈`. -/
|
||
theorem variablesAt_mem (s : prog.State) (sv : StateVariables L prog) :
|
||
(s, variablesAt s sv) ∈ sv :=
|
||
(FiniteMap.locate (states_memKey s sv)).2
|
||
|
||
/-- Agda: `m₁≼m₂⇒m₁[k]ᵐ≼m₂[k]ᵐ`, specialized the way `Forward.agda` uses it. -/
|
||
theorem variablesAt_le {sv₁ sv₂ : StateVariables L prog} (hle : sv₁ ≤ sv₂)
|
||
(s : prog.State) : variablesAt s sv₁ ≤ variablesAt s sv₂ :=
|
||
FiniteMap.le_of_mem_mem prog.states_nodup hle
|
||
(variablesAt_mem s sv₁) (variablesAt_mem s sv₂)
|
||
|
||
variable [FiniteHeightLattice L]
|
||
|
||
/-- Agda: `joinForKey`. -/
|
||
def joinForKey (k : prog.State) (sv : StateVariables L prog) :
|
||
VariableValues L prog :=
|
||
(sv.valuesAt (prog.incoming k)).foldr (· ⊔ ·) (botV L prog)
|
||
|
||
/-- Agda: `joinForKey-Mono`. -/
|
||
theorem joinForKey_mono (k : prog.State) :
|
||
Monotone (joinForKey (L := L) k) := by
|
||
intro sv₁ sv₂ hle
|
||
exact foldr_mono _ (FiniteMap.valuesAt_le hle (prog.incoming k)) (le_refl _)
|
||
(fun b _ _ hab => sup_le_sup_right hab b)
|
||
(fun a _ _ hab => sup_le_sup_left hab a)
|
||
|
||
/-- Agda: `joinAll` (the "Exercise 4.26" generalized update with `f = id`). -/
|
||
def joinAll (sv : StateVariables L prog) : StateVariables L prog :=
|
||
FiniteMap.generalizedUpdate id joinForKey prog.states sv
|
||
|
||
/-- Agda: `joinAll-Mono`. -/
|
||
theorem joinAll_mono : Monotone (joinAll (L := L) (prog := prog)) :=
|
||
FiniteMap.generalizedUpdate_monotone monotone_id joinForKey_mono
|
||
|
||
/-- Agda: `joinAll-k∈ks-≡`. -/
|
||
theorem joinAll_mem_eq {s : prog.State} {vs : VariableValues L prog}
|
||
{sv : StateVariables L prog} (h : (s, vs) ∈ joinAll sv) :
|
||
vs = joinForKey s sv :=
|
||
FiniteMap.generalizedUpdate_mem_eq (prog.states_complete s) h
|
||
|
||
/-- Agda: `variablesAt-joinAll`. -/
|
||
theorem variablesAt_joinAll (s : prog.State) (sv : StateVariables L prog) :
|
||
variablesAt s (joinAll sv) = joinForKey s sv :=
|
||
joinAll_mem_eq (variablesAt_mem s (joinAll sv))
|
||
|
||
/-! ### Lifting an interpretation to variable maps -/
|
||
|
||
variable [I : LatticeInterpretation L]
|
||
|
||
omit [FiniteHeightLattice L] in
|
||
/-- Agda: `⟦_⟧ᵛ`. -/
|
||
def interpV (vs : VariableValues L prog) (ρ : Env) : Prop :=
|
||
∀ (k : String) (l : L), (k, l) ∈ vs →
|
||
∀ (v : Value), Env.Mem (k, v) ρ → I.interp l v
|
||
|
||
/-- Agda: `⟦⊥ᵛ⟧ᵛ∅`. -/
|
||
theorem interpV_botV_nil : interpV (botV L prog) [] := by
|
||
intro k l _ v hmem
|
||
cases hmem
|
||
|
||
omit [FiniteHeightLattice L] in
|
||
/-- Agda: `⟦⟧ᵛ-⊔ᵛ-∨`. -/
|
||
theorem interpV_sup {vs₁ vs₂ : VariableValues L prog} {ρ : Env}
|
||
(h : interpV vs₁ ρ ∨ interpV vs₂ ρ) : interpV (vs₁ ⊔ vs₂) ρ := by
|
||
intro k l hmem v hv
|
||
obtain ⟨l₁, l₂, rfl, h₁, h₂⟩ := FiniteMap.mem_sup hmem
|
||
rcases h with h | h
|
||
· exact I.interp_sup v (Or.inl (h _ _ h₁ _ hv))
|
||
· exact I.interp_sup v (Or.inr (h _ _ h₂ _ hv))
|
||
|
||
/-- Agda: `⟦⟧ᵛ-foldr`. -/
|
||
theorem interpV_foldr {vs : VariableValues L prog}
|
||
{vss : List (VariableValues L prog)} {ρ : Env}
|
||
(hvs : interpV vs ρ) (hmem : vs ∈ vss) :
|
||
interpV (vss.foldr (· ⊔ ·) (botV L prog)) ρ := by
|
||
induction vss with
|
||
| nil => cases hmem
|
||
| cons vs' vss' ih =>
|
||
rcases List.mem_cons.mp hmem with rfl | hmem'
|
||
· exact interpV_sup (Or.inl hvs)
|
||
· exact interpV_sup (Or.inr (ih hmem'))
|
||
|
||
end Spa
|