imiel/iris
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Split neutrals from canonical values so stuck eliminators arent encoded via constructor overloading

Browse Source
This commit is contained in:
imiel
2026-04-19 15:03:40 +00:00
parent bb002a4d92
commit 963c9f3e94
5 changed files with 245 additions and 207 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Tests.lean
+39 -22
View File
@@ -84,52 +84,52 @@ def runCase (tc : TestCase) : IO Bool := do
match renderType ty with
| Except.ok actualTy =>
if actualTy == expectedTy then
IO.println s!"PASS {tc.name}"
IO.println s!"pass {tc.name}"
pure true
else
IO.println s!"FAIL {tc.name} (expected type {BidirTT.prettyTm expectedTy}, got {BidirTT.prettyTm actualTy})"
IO.println s!"fail {tc.name} (expected type {BidirTT.prettyTm expectedTy}, got {BidirTT.prettyTm actualTy})"
pure false
| Except.error err =>
IO.println s!"FAIL {tc.name} (could not quote type: {err})"
IO.println s!"fail {tc.name} (could not quote type: {err})"
pure false
| .okTyNorm expectedTy expectedNf, .ok (tm, ty) =>
match renderType ty, renderNormal tm with
| Except.ok actualTy, Except.ok actualNf =>
if actualTy == expectedTy && actualNf == expectedNf then
IO.println s!"PASS {tc.name}"
IO.println s!"pass {tc.name}"
pure true
else if actualTy != expectedTy then
IO.println s!"FAIL {tc.name} (expected type {BidirTT.prettyTm expectedTy}, got {BidirTT.prettyTm actualTy})"
IO.println s!"fail {tc.name} (expected type {BidirTT.prettyTm expectedTy}, got {BidirTT.prettyTm actualTy})"
pure false
else
IO.println s!"FAIL {tc.name} (expected nf {BidirTT.prettyTm expectedNf}, got {BidirTT.prettyTm actualNf})"
IO.println s!"fail {tc.name} (expected nf {BidirTT.prettyTm expectedNf}, got {BidirTT.prettyTm actualNf})"
pure false
| Except.error err, _ =>
IO.println s!"FAIL {tc.name} (could not quote type: {err})"
IO.println s!"fail {tc.name} (could not quote type: {err})"
pure false
| _, Except.error err =>
IO.println s!"FAIL {tc.name} (could not normalize term: {err})"
IO.println s!"fail {tc.name} (could not normalize term: {err})"
pure false
| .okTy expectedTy, .error err =>
IO.println s!"FAIL {tc.name} (expected type {BidirTT.prettyTm expectedTy}, got error {err})"
IO.println s!"fail {tc.name} (expected type {BidirTT.prettyTm expectedTy}, got error {err})"
pure false
| .okTyNorm expectedTy _, .error err =>
IO.println s!"FAIL {tc.name} (expected type {BidirTT.prettyTm expectedTy}, got error {err})"
IO.println s!"fail {tc.name} (expected type {BidirTT.prettyTm expectedTy}, got error {err})"
pure false
| .errContains needle, .error err =>
if containsText err needle then
IO.println s!"PASS {tc.name}"
IO.println s!"pass {tc.name}"
pure true
else
IO.println s!"FAIL {tc.name} (expected error containing {needle}, got {err})"
IO.println s!"fail {tc.name} (expected error containing {needle}, got {err})"
pure false
| .errContains needle, .ok (_, ty) =>
match renderType ty with
| Except.ok actualTy =>
IO.println s!"FAIL {tc.name} (expected error containing {needle}, got type {BidirTT.prettyTm actualTy})"
IO.println s!"fail {tc.name} (expected error containing {needle}, got type {BidirTT.prettyTm actualTy})"
pure false
| Except.error err =>
IO.println s!"FAIL {tc.name} (expected error containing {needle}, got quote failure {err})"
IO.println s!"fail {tc.name} (expected error containing {needle}, got quote failure {err})"
pure false
def runInternalSafetyChecks : IO Bool := do
@@ -138,14 +138,30 @@ def runInternalSafetyChecks : IO Bool := do
| Except.error err => containsText err "bad de Bruijn index 0"
| Except.ok _ => false
let malformedQuoteOk :=
match quote 0 (.var 0) with
match quote 0 (.neu (.var 0)) with
| Except.error err => containsText err "bad level 0"
| Except.ok _ => false
if malformedEvalOk && malformedQuoteOk then
IO.println "PASS malformed core terms are rejected safely"
IO.println "pass malformed core terms are rejected safely"
pure true
else
IO.println "FAIL malformed core terms are rejected safely"
IO.println "fail malformed core terms are rejected safely"
pure false
def runNeutralRepresentationChecks : IO Bool := do
let stuckAppOk :=
match vApp (.neu (.var 0)) .zero with
| Except.ok (.neu (.app (.var 0) .zero)) => true
| _ => false
let stuckNatElimOk :=
match vNatElim .nat .zero (.neu (.var 1)) (.neu (.var 0)) with
| Except.ok (.neu (.natElim .nat .zero (.neu (.var 1)) (.var 0))) => true
| _ => false
if stuckAppOk && stuckNatElimOk then
IO.println "pass stuck eliminators stay in the neutral fragment"
pure true
else
IO.println "fail stuck eliminators stay in the neutral fragment"
pure false
def runPrettyPrinterChecks : IO Bool := do
@@ -160,23 +176,24 @@ def runPrettyPrinterChecks : IO Bool := do
containsText typeText "Pi (x0 : U0)" &&
!containsText typeText "#"
if ok then
IO.println "PASS pretty printer rehydrates binder names"
IO.println "pass pretty printer rehydrates binder names"
pure true
else
IO.println s!"FAIL pretty printer rehydrates binder names (term: {termText}, type: {typeText})"
IO.println s!"fail pretty printer rehydrates binder names (term: {termText}, type: {typeText})"
pure false
| Except.error err =>
IO.println s!"FAIL pretty printer rehydrates binder names (could not quote type: {err})"
IO.println s!"fail pretty printer rehydrates binder names (could not quote type: {err})"
pure false
| .error err =>
IO.println s!"FAIL pretty printer rehydrates binder names (could not elaborate fixture: {err})"
IO.println s!"fail pretty printer rehydrates binder names (could not elaborate fixture: {err})"
pure false
def main : IO UInt32 := do
let results ← cases.mapM runCase
let safetyOk ← runInternalSafetyChecks
let neutralOk ← runNeutralRepresentationChecks
let prettyOk ← runPrettyPrinterChecks
let allResults := results ++ [safetyOk, prettyOk]
let allResults := results ++ [safetyOk, neutralOk, prettyOk]
let failed := allResults.countP (· == false)
if failed == 0 then
IO.println s!"\n{allResults.length} passed, 0 failed"