FF CakeML and finish porting of proofs to new finite maps for analysis result and type map

hol4/CertificateCheckerScript.sml

@@ -106,7 +106,7 @@ val CertificateCmd_checking_is_sound = store_thm ("CertificateCmd_checking_is_so
   \\ rpt strip_tac
   \\ `?outVars. ssa f (freeVars f) outVars` by (match_mp_tac validSSA_sound \\ fs[])
   \\ qspecl_then
-       [`f`, `A`, `E1`, `freeVars f`, `LN`, `outVars`, `elo`, `ehi`, `err`, `P`, `defVars`]
+       [`f`, `A`, `E1`, `freeVars f`, `LN`, `outVars`, `P`, `defVars`]
        destruct validIntervalboundsCmd_sound
   \\ fs[dVars_range_valid_def, vars_typed_def, fVars_P_sound_def]
   \\ qspecl_then

hol4/DaisyMapScript.sml

 open preamble
-open MachineTypeTheory ExpressionAbbrevsTheory
+open MachineTypeTheory ExpressionAbbrevsTheory DaisyTactics
 
 val _ = new_theory "DaisyMap";
 
@@ -32,6 +32,7 @@ val expCompare_def = Define `
         else (if u1 = Neg then Lt else Gt)
       | Unop _ _, Binop _ _ _ => Lt
       | Unop _ _, Downcast _ _ => Lt
+      | Unop _ _, Fma _ _ _ => Lt
       | Unop _ _, _ => Gt
       | Downcast m1 e1, Downcast m2 e2 =>
           if m1 = m2
@@ -59,7 +60,24 @@ val expCompare_def = Define `
                   | Lt => Lt
                   | Gt => Gt)
              | _ => res)
-     |_ , _ => Gt`;
+      | Fma e1 e2 e3, Fma e4 e5 e6 =>
+        (case expCompare e1 e4 of
+         | Eq =>
+           (case expCompare e2 e5 of
+           | Eq => expCompare e3 e6
+           | Lt => Lt
+           | Gt => Gt)
+         | Lt => Lt
+         | Gt => Gt)
+      | _ , Fma e1 e2 e3 => Lt
+      | Fma e1 e2 e3, _ => Gt
+      |_ , _ => Gt`;
+
+val expCompare_refl = store_thm (
+  "expCompare_refl",
+  ``!e. expCompare e e = Eq``,
+  Induct \\ rpt strip_tac \\ simp[ Once expCompare_def]
+  \\ Cases_on `b` \\ fs[] );
 
 val DaisyMapList_insert_def = Define `
   (DaisyMapList_insert e k NIL = [(e,k)]) /\
@@ -81,12 +99,12 @@ val DaisyMapTree_insert_def = Define `
   (DaisyMapTree_insert e k (Leaf (e1,k1)) =
      case (expCompare e e1) of
             | Lt => Node (e1,k1) (Leaf (e,k)) (LeafN)
-            | Eq => Leaf (e1,k1)
+            | Eq => Leaf (e1,k)
             | Gt => Node (e1,k1) (LeafN) (Leaf (e,k))) /\
   (DaisyMapTree_insert e k (Node (e1,k1) tl tr) =
      case (expCompare e e1) of
             | Lt => Node (e1,k1) (DaisyMapTree_insert e k tl) tr
-            | Eq => (Node (e1, k1) tl tr)
+            | Eq => (Node (e1, k) tl tr)
             | Gt => Node (e1,k1) tl (DaisyMapTree_insert e k tr))`;
 
 val DaisyMapTree_find_def = Define `
@@ -108,6 +126,28 @@ val DaisyMapTree_mem_def = Define `
 val DaisyMapTree_empty_def = Define `
   DaisyMapTree_empty = LeafN `;
 
+val DaisyMapTree_find_injective = store_thm (
+  "DaisyMapTree_find_injective",
+  ``!e a b Tree.
+      DaisyMapTree_find e Tree = SOME a /\
+      DaisyMapTree_find e Tree = SOME b ==>
+      a = b``,
+  rpt strip_tac
+  \\ Cases_on `Tree` \\ fs[DaisyMapTree_find_def]);
+
+val DaisyMapTree_correct = store_thm (
+  "DaisyMapTree_correct",
+  ``!Tree k v.
+      DaisyMapTree_find k (DaisyMapTree_insert k v Tree) = SOME v``,
+  Induct_on `Tree`
+  \\ fs[DaisyMapTree_find_def, DaisyMapTree_insert_def]
+  \\ rpt strip_tac \\ fs[expCompare_refl]
+  >- (Cases_on `a` \\ fs[DaisyMapTree_insert_def]
+      \\ Cases_on `expCompare k q` \\ fs[DaisyMapTree_find_def]
+      \\ first_x_assum irule \\ fs[])
+  \\ Cases_on `a` \\ fs[DaisyMapTree_insert_def]
+  \\ Cases_on `expCompare k q` \\ fs[DaisyMapTree_find_def, expCompare_refl]);
+
 val _ = type_abbrev ("typeMap", ``:(real exp # mType) binTree``);
 val _ = type_abbrev ("analysisResult", ``:(real exp # ((real # real) # real)) binTree``);
 

hol4/IntervalValidationScript.sml

@@ -379,7 +379,7 @@ val swap_Gamma_bstep = store_thm (
   >- (irule swap_Gamma_eval_exp \\ qexists_tac `Gamma1` \\ fs[]));
 
 val validIntervalboundsCmd_sound = store_thm ("validIntervalboundsCmd_sound",
-  ``!f A E fVars dVars outVars elo ehi err P Gamma.
+  ``!f A E fVars dVars outVars P Gamma.
       ssa f (union fVars dVars) outVars /\
       dVars_range_valid dVars E A /\
       fVars_P_sound fVars E P /\

hol4/TypingScript.sml

@@ -30,8 +30,6 @@ val typeExpression_def = Define `
         | SOME m1 => if (morePrecise m1 m) then SOME m else NONE
         | NONE => NONE`;
 
-!eval_funs;
-
 add_unevaluated_function ``typeExpression``;
 
 val typeMap_def = Define `

cakeml @ 80074542

-Subproject commit 19c41e5bac090d86a4245e2b6054ef710c42a402
+Subproject commit 800745426c5c2ef2f5c5475c26640641dd222f04