summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorThomas Bauereiss2018-05-12 11:16:27 +0100
committerThomas Bauereiss2018-05-12 11:20:33 +0100
commit526b71d5fed2f6a79c41fe482a578a8634a0345a (patch)
tree55cbddb180f05b3d6b33744bf64b630f71f30b52 /src
parent6368f7fea326340ffd1c2b6e3ff3bcdccdeb9cec (diff)
Fix bug in handling of registers with option type
Also add test cases and Isabelle lemmas
Diffstat (limited to 'src')
-rw-r--r--src/state.ml15
1 files changed, 14 insertions, 1 deletions
diff --git a/src/state.ml b/src/state.ml
index 5a360456..ab63747c 100644
--- a/src/state.ml
+++ b/src/state.ml
@@ -286,7 +286,7 @@ let register_refs_lem mwords registers =
"";
"val option_of_regval : forall 'a. (register_value -> maybe 'a) -> register_value -> maybe (maybe 'a)";
"let option_of_regval of_regval = function";
- " | Regval_option v -> Maybe.map of_regval v";
+ " | Regval_option v -> Just (Maybe.bind v of_regval)";
" | _ -> Nothing";
"end";
"";
@@ -388,6 +388,19 @@ let generate_isa_lemmas mwords (Defs defs : tannot defs) =
"proof -";
" from assms have \"of_rv \\<circ> rv_of = Some\" by auto";
" then show ?thesis by (auto simp: vector_of_regval_def regval_of_vector_def)";
+ "qed";
+ "";
+ "lemma option_of_rv_rv_of_option[simp]:";
+ " assumes \"\\<And>v. of_rv (rv_of v) = Some v\"";
+ " shows \"option_of_regval of_rv (regval_of_option rv_of v) = Some v\"";
+ " using assms by (cases v) (auto simp: option_of_regval_def regval_of_option_def)";
+ "";
+ "lemma list_of_rv_rv_of_list[simp]:";
+ " assumes \"\\<And>v. of_rv (rv_of v) = Some v\"";
+ " shows \"list_of_regval of_rv (regval_of_list rv_of v) = Some v\"";
+ "proof -";
+ " from assms have \"of_rv \\<circ> rv_of = Some\" by auto";
+ " with assms show ?thesis by (induction v) (auto simp: list_of_regval_def regval_of_list_def)";
"qed"] ^^
hardline ^^ hardline ^^
separate_map (hardline ^^ hardline) register_lemmas registers