Lean migration cleanup: collapse FixedHeight struct into FiniteHeightLattice typeclass
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>
This commit is contained in:
@@ -1,30 +1,3 @@
|
||||
/-
|
||||
Port of `Analysis/Sign.agda`.
|
||||
|
||||
Correspondence:
|
||||
Sign (+ / - / 0ˢ) ↦ Sign.plus / Sign.minus / Sign.zero
|
||||
_≟ᵍ_, ≡-equiv, ≡-Decidable ↦ deriving DecidableEq
|
||||
SignLattice (AboveBelow) ↦ SignLattice
|
||||
AB.Plain 0ˢ ↦ the AboveBelow FiniteHeightLattice instance,
|
||||
seeded by `Inhabited Sign := ⟨.zero⟩`
|
||||
plus, minus ↦ plus, minus
|
||||
plus-Monoˡ/ʳ, minus-Monoˡ/ʳ (postulates in Agda!)
|
||||
↦ plus_mono_left/right, minus_mono_left/right —
|
||||
now actually proved, via
|
||||
AboveBelow.monotone₂_of_strict
|
||||
plus-Mono₂, minus-Mono₂ ↦ plus_mono₂, minus_mono₂
|
||||
⟦_⟧ᵍ ↦ interpSign
|
||||
⟦⟧ᵍ-respects-≈ᵍ ↦ (trivial with `=`)
|
||||
⟦⟧ᵍ-⊔ᵍ-∨, ⟦⟧ᵍ-⊓ᵍ-∧ ↦ interpSign_sup, interpSign_inf
|
||||
s₁≢s₂⇒¬s₁∧s₂ ↦ interpSign_mk_disjoint
|
||||
latticeInterpretationᵍ ↦ signInterpretation
|
||||
WithProg.eval, eval-Monoʳ ↦ SignAnalysis.eval, eval_mono
|
||||
SignEval (instance) ↦ SignAnalysis.exprEvaluator
|
||||
plus-valid, minus-valid ↦ plus_valid, minus_valid
|
||||
eval-valid, SignEvalValid ↦ eval_valid
|
||||
output ↦ SignAnalysis.output
|
||||
analyze-correct ↦ SignAnalysis.analyze_correct
|
||||
-/
|
||||
import Spa.Analysis.Forward
|
||||
import Spa.Analysis.Utils
|
||||
import Spa.Showable
|
||||
@@ -43,14 +16,11 @@ instance : Showable Sign :=
|
||||
| .minus => "-"
|
||||
| .zero => "0"⟩
|
||||
|
||||
/-- Agda: the module parameter `x = 0ˢ` of `AB.Plain` (it seeds the
|
||||
`FiniteHeightLattice (AboveBelow Sign)` instance). -/
|
||||
instance : Inhabited Sign := ⟨.zero⟩
|
||||
|
||||
abbrev SignLattice : Type := AboveBelow Sign
|
||||
|
||||
open AboveBelow in
|
||||
/-- Agda: `plus`. -/
|
||||
def plus : SignLattice → SignLattice → SignLattice
|
||||
| bot, _ => bot
|
||||
| _, bot => bot
|
||||
@@ -67,7 +37,6 @@ def plus : SignLattice → SignLattice → SignLattice
|
||||
| mk .zero, mk .zero => mk .zero
|
||||
|
||||
open AboveBelow in
|
||||
/-- Agda: `minus`. -/
|
||||
def minus : SignLattice → SignLattice → SignLattice
|
||||
| bot, _ => bot
|
||||
| _, bot => bot
|
||||
@@ -83,9 +52,6 @@ def minus : SignLattice → SignLattice → SignLattice
|
||||
| mk .zero, mk .minus => mk .plus
|
||||
| mk .zero, mk .zero => mk .zero
|
||||
|
||||
/-- Agda: `plus-Mono₂` (its components were postulates in Agda; `plus` is a
|
||||
strict operation on the flat lattice, so monotonicity holds regardless of the
|
||||
sign table). -/
|
||||
theorem plus_mono₂ : Monotone₂ plus :=
|
||||
AboveBelow.monotone₂_of_strict plus
|
||||
(fun y => by cases y <;> rfl)
|
||||
@@ -95,13 +61,10 @@ theorem plus_mono₂ : Monotone₂ plus :=
|
||||
rcases x with _ | _ | s <;>
|
||||
first | exact absurd rfl hx | rfl | (cases s <;> rfl))
|
||||
|
||||
/-- Agda: `plus-Monoˡ` — a postulate there, a theorem here. -/
|
||||
theorem plus_mono_left (s₂ : SignLattice) : Monotone (plus · s₂) := plus_mono₂.1 s₂
|
||||
|
||||
/-- Agda: `plus-Monoʳ` — a postulate there, a theorem here. -/
|
||||
theorem plus_mono_right (s₁ : SignLattice) : Monotone (plus s₁) := plus_mono₂.2 s₁
|
||||
|
||||
/-- Agda: `minus-Mono₂` (likewise from strictness of `minus`). -/
|
||||
theorem minus_mono₂ : Monotone₂ minus :=
|
||||
AboveBelow.monotone₂_of_strict minus
|
||||
(fun y => by cases y <;> rfl)
|
||||
@@ -111,13 +74,10 @@ theorem minus_mono₂ : Monotone₂ minus :=
|
||||
rcases x with _ | _ | s <;>
|
||||
first | exact absurd rfl hx | rfl | (cases s <;> rfl))
|
||||
|
||||
/-- Agda: `minus-Monoˡ` — a postulate there, a theorem here. -/
|
||||
theorem minus_mono_left (s₂ : SignLattice) : Monotone (minus · s₂) := minus_mono₂.1 s₂
|
||||
|
||||
/-- Agda: `minus-Monoʳ` — a postulate there, a theorem here. -/
|
||||
theorem minus_mono_right (s₁ : SignLattice) : Monotone (minus s₁) := minus_mono₂.2 s₁
|
||||
|
||||
/-- Agda: `⟦_⟧ᵍ`. -/
|
||||
def interpSign : SignLattice → Value → Prop
|
||||
| .bot, _ => False
|
||||
| .top, _ => True
|
||||
@@ -125,7 +85,6 @@ def interpSign : SignLattice → Value → Prop
|
||||
| .mk .zero, v => v = .int 0
|
||||
| .mk .minus, v => ∃ n : ℕ, v = .int (-(n + 1))
|
||||
|
||||
/-- Agda: `s₁≢s₂⇒¬s₁∧s₂`. -/
|
||||
theorem interpSign_mk_disjoint {s₁ s₂ : Sign} (hne : s₁ ≠ s₂) {v : Value} :
|
||||
¬(interpSign (.mk s₁) v ∧ interpSign (.mk s₂) v) := by
|
||||
rintro ⟨h₁, h₂⟩
|
||||
@@ -154,17 +113,14 @@ theorem interpSign_mk_disjoint {s₁ s₂ : Sign} (hne : s₁ ≠ s₂) {v : Val
|
||||
injection hv with hz
|
||||
omega
|
||||
|
||||
/-- Agda: `⟦⟧ᵍ-⊔ᵍ-∨` (via the factored flat-lattice lemma). -/
|
||||
theorem interpSign_sup {s₁ s₂ : SignLattice} (v : Value)
|
||||
(h : interpSign s₁ v ∨ interpSign s₂ v) : interpSign (s₁ ⊔ s₂) v :=
|
||||
AboveBelow.interp_sup_of (fun _ h => h) (fun _ => trivial) v h
|
||||
|
||||
/-- Agda: `⟦⟧ᵍ-⊓ᵍ-∧` (via the factored flat-lattice lemma). -/
|
||||
theorem interpSign_inf {s₁ s₂ : SignLattice} (v : Value)
|
||||
(h : interpSign s₁ v ∧ interpSign s₂ v) : interpSign (s₁ ⊓ s₂) v :=
|
||||
AboveBelow.interp_inf_of (fun hne _ => interpSign_mk_disjoint hne) v h
|
||||
|
||||
/-- Agda: `latticeInterpretationᵍ` (an instance there too). -/
|
||||
instance signInterpretation : LatticeInterpretation SignLattice where
|
||||
interp := interpSign
|
||||
interp_sup := fun {l₁ l₂} v h => interpSign_sup (s₁ := l₁) (s₂ := l₂) v h
|
||||
@@ -172,11 +128,8 @@ instance signInterpretation : LatticeInterpretation SignLattice where
|
||||
|
||||
namespace SignAnalysis
|
||||
|
||||
/-! Agda: `module WithProg (prog : Program)`. -/
|
||||
|
||||
variable (prog : Program)
|
||||
|
||||
/-- Agda: `WithProg.eval`. -/
|
||||
def eval : Expr → VariableValues SignLattice prog → SignLattice
|
||||
| .add e₁ e₂, vs => plus (eval e₁ vs) (eval e₂ vs)
|
||||
| .sub e₁ e₂, vs => minus (eval e₁ vs) (eval e₂ vs)
|
||||
@@ -185,7 +138,6 @@ def eval : Expr → VariableValues SignLattice prog → SignLattice
|
||||
| .num 0, _ => .mk .zero
|
||||
| .num (_ + 1), _ => .mk .plus
|
||||
|
||||
/-- Agda: `WithProg.eval-Monoʳ`. -/
|
||||
theorem eval_mono (e : Expr) : Monotone (eval prog e) := by
|
||||
induction e with
|
||||
| add e₁ e₂ ih₁ ih₂ =>
|
||||
@@ -208,15 +160,12 @@ theorem eval_mono (e : Expr) : Monotone (eval prog e) := by
|
||||
intro vs₁ vs₂ _
|
||||
cases n <;> exact le_refl _
|
||||
|
||||
/-- Agda: the `SignEval` instance. -/
|
||||
instance exprEvaluator : ExprEvaluator SignLattice prog :=
|
||||
⟨eval prog, eval_mono prog⟩
|
||||
|
||||
/-- Agda: `WithProg.result`/`output` — the analysis result, printed. -/
|
||||
def output : String :=
|
||||
show' (result SignLattice prog)
|
||||
|
||||
/-- Agda: `plus-valid`. -/
|
||||
theorem plus_valid {g₁ g₂ : SignLattice} {z₁ z₂ : ℤ}
|
||||
(h₁ : interpSign g₁ (.int z₁)) (h₂ : interpSign g₂ (.int z₂)) :
|
||||
interpSign (plus g₁ g₂) (.int (z₁ + z₂)) := by
|
||||
@@ -254,7 +203,6 @@ theorem plus_valid {g₁ g₂ : SignLattice} {z₁ z₂ : ℤ}
|
||||
subst h₂
|
||||
omega
|
||||
|
||||
/-- Agda: `minus-valid`. -/
|
||||
theorem minus_valid {g₁ g₂ : SignLattice} {z₁ z₂ : ℤ}
|
||||
(h₁ : interpSign g₁ (.int z₁)) (h₂ : interpSign g₂ (.int z₂)) :
|
||||
interpSign (minus g₁ g₂) (.int (z₁ - z₂)) := by
|
||||
@@ -292,7 +240,6 @@ theorem minus_valid {g₁ g₂ : SignLattice} {z₁ z₂ : ℤ}
|
||||
subst h₂
|
||||
omega
|
||||
|
||||
/-- Agda: `eval-valid` / the `SignEvalValid` instance. -/
|
||||
instance eval_valid : ValidExprEvaluator SignLattice prog := by
|
||||
constructor
|
||||
intro vs ρ e v hev
|
||||
@@ -302,7 +249,7 @@ instance eval_valid : ValidExprEvaluator SignLattice prog := by
|
||||
show interpSign (eval prog (.num n) vs) (.int n)
|
||||
cases n with
|
||||
| zero => rfl
|
||||
| succ n' => exact ⟨n', congrArg Value.int (by push_cast; ring)⟩
|
||||
| succ n' => exact ⟨n', congrArg Value.int (by norm_cast)⟩
|
||||
| var x v hxv =>
|
||||
intro hvs
|
||||
show interpSign (eval prog (.var x) vs) v
|
||||
@@ -325,7 +272,6 @@ instance eval_valid : ValidExprEvaluator SignLattice prog := by
|
||||
show interpSign (eval prog (.sub e₁ e₂) vs) (.int (z₁ - z₂))
|
||||
exact minus_valid h₁ h₂
|
||||
|
||||
/-- Agda: `WithProg.analyze-correct`. -/
|
||||
theorem analyze_correct {ρ : Env} (hrun : EvalStmt [] prog.rootStmt ρ) :
|
||||
interpV (variablesAt prog.finalState (result SignLattice prog)) ρ :=
|
||||
Spa.analyze_correct SignLattice prog hrun
|
||||
|
||||
Reference in New Issue
Block a user