From a273a862eaa71fd98c048686e73311ee48120ce4 Mon Sep 17 00:00:00 2001
From: Heiko Becker <hbecker@mpi-sws.org>
Date: Wed, 6 Oct 2021 12:12:01 +0200
Subject: [PATCH] Make checker store actual error bound inferred

---
 checkerScript.sml | 18 +++++++++++-------
 realZeroLib.sml   |  2 +-
 2 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/checkerScript.sml b/checkerScript.sml
index 143e5ac..c60c734 100644
--- a/checkerScript.sml
+++ b/checkerScript.sml
@@ -189,10 +189,12 @@ Definition validateZerosLeqErr_def:
                          (ub + B * e))
     in
       if ~ (validBounds iv realZeros ∧ recordered (FST iv) realZeros (SND iv)) then
-          Invalid "Zeros not correctly spaced"
+          (Invalid "Zeros not correctly spaced", 0)
       else if ~ (LENGTH realZeros = numZeros) then
-          Invalid "Did not find sufficient zeros"
-      else isValid (globalErr ≤ eps) "Bounding error too large"
+          (Invalid "Did not find sufficient zeros", 0)
+      else if globalErr ≤ eps
+      then (Valid, globalErr)
+      else (Invalid "Bounding error too large", 0)
 End
 
 (* Unused for new structure
@@ -280,8 +282,8 @@ Proof
 QED
 
 Theorem validateZerosLeqErr_EVERY:
-  ∀ err errorp iv zeroList zeros.
-    validateZerosLeqErr errorp iv zeroList err zeros = Valid ⇒
+  ∀ err errorp iv zeroList zeros eps.
+    validateZerosLeqErr errorp iv zeroList err zeros = (Valid, eps) ⇒
     let realZeros =
         (findN zeros (λ(u,v). poly (diff errorp) u * poly (diff errorp) v ≤ 0)
          zeroList)
@@ -293,6 +295,7 @@ Theorem validateZerosLeqErr_EVERY:
 Proof
   gs[validateZerosLeqErr_def, isValid_def]
   >> rpt gen_tac >> rpt (cond_cases_tac >> gs[])
+  >> disch_then kall_tac
   >> qmatch_goalsub_abbrev_tac ‘EVERY all_conds_pred realZeros’
   >> ‘all_conds_pred =
       λ x. (λ (u,v). FST iv ≤ u ∧ v ≤ SND iv) x ∧
@@ -330,10 +333,10 @@ Proof
 QED
 
 Theorem validateZerosLeqErr_sound:
-  ∀ deriv errorp iv zerosList zeros err.
+  ∀ deriv errorp iv zerosList zeros err eps.
     deriv = diff errorp ∧
     {x | FST iv ≤ x ∧ x ≤ SND iv ∧ (poly deriv x = &0)} HAS_SIZE zeros ∧
-    validateZerosLeqErr errorp iv zerosList err zeros = Valid ⇒
+    validateZerosLeqErr errorp iv zerosList err zeros = (Valid, eps) ⇒
     ∀ x.
       FST iv ≤ x ∧ x ≤ SND iv ⇒
       abs(poly errorp x) ≤ err
@@ -345,6 +348,7 @@ Proof
   >> qpat_x_assum ‘validateZerosLeqErr _ _ _ _ _ = _’ mp_tac
   >> gs[validateZerosLeqErr_def, isValid_def]
   >> rpt (cond_cases_tac >> gs[])
+  >> disch_then kall_tac
   >> pop_assum mp_tac
   >> qmatch_goalsub_abbrev_tac ‘computed_ub ≤ err’
   >> strip_tac >> irule REAL_LE_TRANS
diff --git a/realZeroLib.sml b/realZeroLib.sml
index 7531edf..c9e2d46 100644
--- a/realZeroLib.sml
+++ b/realZeroLib.sml
@@ -163,7 +163,7 @@ struct
             Parse.Term ‘validateZerosLeqErr ^poly ^dom ^zeroList ^eps ^numZeros’
             |> EVAL
           val _ = save_thm ("validationThm", validationThm)
-          val _ = if Term.compare (rhs o concl $ validationThm, “Valid”) = EQUAL then ()
+          val _ = if Term.compare (rhs o concl $ validationThm |> pairSyntax.dest_pair |> fst, “Valid”) = EQUAL then ()
                   else raise ZeroLibErr "Failed to prove validity of zeros found by Sollya"
           val resThm = (MATCH_MP (REWRITE_RULE [GSYM AND_IMP_INTRO] validateZerosLeqErr_sound) (GSYM polyDiff))
                         |> Q.SPEC ‘(^lb, ^ub)’ |> SIMP_RULE std_ss []
-- 
GitLab