Commit 13438299 authored by Heiko Becker's avatar Heiko Becker

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

parent b62b0ee7
......@@ -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
......
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``);
......
This diff is collapsed.
......@@ -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 /\
......
......@@ -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 `
......
Subproject commit 19c41e5bac090d86a4245e2b6054ef710c42a402
Subproject commit 800745426c5c2ef2f5c5475c26640641dd222f04
This diff is collapsed.
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment