diff --git a/Micro_C_Examples/C_While_Examples.thy b/Micro_C_Examples/C_While_Examples.thy index 966f36ca..f5d348d2 100644 --- a/Micro_C_Examples/C_While_Examples.thy +++ b/Micro_C_Examples/C_While_Examples.thy @@ -88,18 +88,11 @@ lemma ucincl_Un [ucincl_intros]: using assms by (intro ucinclI ucpredI) (metis UN_iff asat_def asat_derived_order_monotone) lemma c_break_imm_correct: - assumes \while_fuel \ 1\ - shows \\; c_break_imm while_fuel \\<^sub>F c_break_imm_contract\ + assumes \while_fuel = 1\ + shows \\; c_break_imm while_fuel \\<^sub>F c_break_imm_contract\ +using assms apply (crush_boot f: c_break_imm_def contract: c_break_imm_contract_def) apply crush_base - apply (ucincl_discharge\ - rule_tac - INV=\\k. (\g. x \\\\ g\(0x2A :: c_uint)) \ (\g bf. xa \\\\ g\bf)\ - and INV'=\\k. (\g. x \\\\ g\(0x2A :: c_uint)) \ (\g. xa \\\\ g\(0 :: c_uint))\ - and \=\\_. \False\\ - and \=\\_. \False\\ - in wp_bounded_while_framedI\) - apply (crush_base simp add: ucincl_intros split: if_splits) done subsection \Continue in Loop\ diff --git a/Micro_C_Examples/Simple_C_Functions.thy b/Micro_C_Examples/Simple_C_Functions.thy index 33ae9b61..64e17ac3 100644 --- a/Micro_C_Examples/Simple_C_Functions.thy +++ b/Micro_C_Examples/Simple_C_Functions.thy @@ -998,28 +998,28 @@ definition c_count_down_contract :: \c_uint \ ('s::{sepalg}, c ucincl_auto c_count_down_contract lemma c_count_down_spec: - assumes \while_fuel = unat n\ - shows \\; c_count_down while_fuel n \\<^sub>F c_count_down_contract n\ + assumes \while_fuel = Suc (unat n)\ + shows \\; c_count_down while_fuel n \\<^sub>F c_count_down_contract n\ apply (crush_boot f: c_count_down_def contract: c_count_down_contract_def) apply crush_base apply (ucincl_discharge\ rule_tac - INV=\\k. (\g. x \\\\ g\(1 :: c_uint)) \ - (\g. xa \\\\ g\(0 :: c_uint)) \ - (\g. xb \\\\ g\(of_nat k :: c_uint))\ + INV=\\k. (\g. x \\\\ g\((if k = 0 then 0 else 1) :: c_uint)) \ + (\g. xa \\\\ g\((if k = 0 then 1 else 0) :: c_uint)) \ + (\g. xb \\\\ g\(of_nat (k - 1) :: c_uint))\ and INV'=\\k. (\g. x \\\\ g\(1 :: c_uint)) \ (\g. xa \\\\ g\(0 :: c_uint)) \ - (\g. xb \\\\ g\(of_nat (Suc k) :: c_uint))\ + (\g. xb \\\\ g\(of_nat k :: c_uint))\ and \=\\_. \False\\ and \=\\_. \False\\ in wp_bounded_while_framedI\) apply (crush_base simp add: c_unsigned_eq_def c_unsigned_sub_def unat_of_nat_eq word_of_nat_eq_0_iff of_nat_diff linorder_not_less unat_gt_0 word_of_nat_less)+ - apply (metis add.commute assms less_is_non_zero_p1 word_of_nat_less) - apply (metis add.commute assms less_is_non_zero_p1 word_of_nat_less) - apply (metis add.commute assms less_is_non_zero_p1 word_of_nat_less) - apply (simp add: assms unat_of_nat_eq) + subgoal apply (simp add: assms) using dvd_imp_le unat_lt2p[where x=n] by fastforce + subgoal apply (simp add: assms) using dvd_imp_le unat_lt2p[where x=n] by fastforce + subgoal apply (simp add: assms) using dvd_imp_le unat_lt2p[where x=n] by fastforce + apply (simp add: assms)+ done end diff --git a/Shallow_Micro_Rust/Rust_Iterator.thy b/Shallow_Micro_Rust/Rust_Iterator.thy index dd1e1da3..ba9355a8 100644 --- a/Shallow_Micro_Rust/Rust_Iterator.thy +++ b/Shallow_Micro_Rust/Rust_Iterator.thy @@ -118,13 +118,18 @@ definition raw_for_loop :: \'a list \ ('a \ ('s,'v subsection\Bounded while loops\ text\A fuel-based while-loop combinator. Terminates by structural recursion on the fuel @{typ nat}. -When fuel reaches 0 the loop returns @{term skip} (unit). The WP invariant rules force the user to -prove fuel sufficiency, so the fuel=0 case is unreachable in verified code.\ +When fuel reaches 0, the loop checks the condition one final time and aborts if another +iteration would be required. This makes fuel insufficiency explicit at runtime and in WP +reasoning.\ + +definition bounded_while_exhausted_msg :: String.literal where [micro_rust_simps]: + \bounded_while_exhausted_msg = String.implode ''bounded_while: exhausted fuel''\ fun bounded_while :: \nat \ ('s, bool, 'r, 'abort, 'i, 'o) expression \ ('s, unit, 'r, 'abort, 'i, 'o) expression \ ('s, unit, 'r, 'abort, 'i, 'o) expression\ where - \bounded_while 0 cond body = skip\ + \bounded_while 0 cond body = + bind cond (\c. if c then panic bounded_while_exhausted_msg else skip)\ | \bounded_while (Suc n) cond body = bind cond (\c. if c then sequence body (bounded_while n cond body) else skip)\ diff --git a/Shallow_Micro_Rust/Rust_Iterator_Lemmas.thy b/Shallow_Micro_Rust/Rust_Iterator_Lemmas.thy index 5636762b..a765b61a 100644 --- a/Shallow_Micro_Rust/Rust_Iterator_Lemmas.thy +++ b/Shallow_Micro_Rust/Rust_Iterator_Lemmas.thy @@ -34,7 +34,8 @@ lemma raw_for_loop_cons [micro_rust_simps]: by (auto simp add: raw_for_loop_def micro_rust_simps) lemma bounded_while_zero [micro_rust_simps]: - shows \bounded_while 0 cond body = skip\ + shows \bounded_while 0 cond body = + bind cond (\c. if c then panic bounded_while_exhausted_msg else skip)\ by simp lemma bounded_while_Suc [micro_rust_simps]: diff --git a/Shallow_Separation_Logic/Triple.thy b/Shallow_Separation_Logic/Triple.thy index 2067baa9..7d5a396c 100644 --- a/Shallow_Separation_Logic/Triple.thy +++ b/Shallow_Separation_Logic/Triple.thy @@ -656,7 +656,8 @@ subsection\Bounded while-loop triples\ text\Basic bounded while-loop triple. The invariant @{term INV} is indexed by remaining fuel. Each iteration step must establish the invariant for one less fuel via a triple on the -condition followed by the body (when the condition is true).\ +condition followed by the body (when the condition is true). At fuel exhaustion, +the rule requires proving the guard cannot still be true (total verification).\ lemma sstriple_bounded_while: fixes INV :: \nat \ 'a assert\ and INV' :: \nat \ 'a assert\ @@ -665,15 +666,33 @@ lemma sstriple_bounded_while: (\c. if c then INV' k else \ ()) \ \ \ \\ and body_step: \\k. k < n \ \ ; INV' k \ body \ (\_. INV k) \ \ \ \\ - and base: \INV 0 \ \ ()\ + and base_cond: \\ ; INV 0 \ cond \ + (\c. if c then \ else \ ()) \ \ \ \\ shows \\ ; INV n \ bounded_while n cond body \ \ \ \ \ \\ - using step body_step + using step body_step base_cond proof (induction n) case 0 - have \\ ; INV 0 \ skip \ (\_. INV 0) \ \ \ \\ - by (rule sstriple_skipI) - then have \\ ; INV 0 \ skip \ \ \ \ \ \\ - using base by (auto intro: sstriple_consequence aentails_refl) + have cond0: \\ ; INV 0 \ cond \ + (\c. if c then \ else \ ()) \ \ \ \\ + using base_cond by simp + have true_branch: \\ ; \ + \ panic bounded_while_exhausted_msg \ \ \ \ \ \\ + by (simp add: sstriple_panic bot_aentails_all) + have false_branch: \\ ; \ () \ skip \ \ \ \ \ \\ + proof - + have \\ ; \ () \ skip \ (\_. \ ()) \ \ \ \\ + by (rule sstriple_skipI) + then show ?thesis + by (auto intro: sstriple_consequence aentails_refl) + qed + have \\ ; INV 0 \ bind cond (\c. if c then panic bounded_while_exhausted_msg else skip) + \ \ \ \ \ \\ + proof (rule sstriple_bindI[OF cond0]) + fix c :: bool + show \\ ; (if c then \ else \ ()) + \ (if c then panic bounded_while_exhausted_msg else skip) \ \ \ \ \ \\ + using true_branch false_branch by (cases c) simp_all + qed then show ?case by (simp add: bounded_while_zero) next case (Suc n) @@ -716,10 +735,15 @@ lemma sstriple_bounded_while_framed: (\c. if c then INV' k else INV 0) \ \ \ \\ and body_step: \\k. k < n \ \ ; INV' k \ body \ (\_. INV k) \ \ \ \\ + and cond_exhaust: \\ ; INV 0 \ cond \ + (\c. if c then \ else INV 0) \ \ \ \\ shows \\ ; INV n \ ((INV 0 \ \ ()) \ (\r. \ r \ \ r) \ (\r. \ r \ \ r)) \ bounded_while n cond body \ \ \ \ \ \\ proof - let ?pc = \(INV 0 \ \ ()) \ (\r. \ r \ \ r) \ (\r. \ r \ \ r)\ + let ?rho = \\r. \ r \ ?pc\ + let ?theta = \\a. \ a \ ?pc\ + let ?psi0 = \\_. INV 0 \ ?pc\ have tau_rho: \\r. \ r \ ?pc \ \ r\ proof - have \\r. \ r \ (\r. \ r \ \ r) \ \ r\ @@ -731,37 +755,89 @@ proof - by (meson aentails_refl aentails_trans' aentails_inter_weaken aforall_entailsL asepconj_mono awand_counit) have inv0_psi: \INV 0 \ ?pc \ \ ()\ by (metis (no_types, lifting) aentails_refl local.asepconj_comm local.aentails_int local.awand_adjoint) - \\Frame each condition step\ - { + have cond_step': \\k. k < n \ + \ ; INV (Suc k) \ ?pc \ cond \ + (\c. if c then INV' k \ ?pc else INV 0 \ ?pc) \ ?rho \ ?theta\ + proof - fix k assume kn: \k < n\ have \\ ; INV (Suc k) \ ?pc \ cond \ - (\c. (if c then INV' k else INV 0) \ ?pc) - \ (\r. \ r \ ?pc) \ (\a. \ a \ ?pc)\ + (\c. (if c then INV' k else INV 0) \ ?pc) \ ?rho \ ?theta\ using cond_step[OF kn] ucincl_INV by (intro sstriple_frame_rule; clarsimp) - moreover have \\c. (if c then INV' k else INV 0) \ ?pc \ - (if c then INV' k \ ?pc else \ ())\ - using inv0_psi by (auto simp add: aentails_refl) - ultimately have \\ ; INV (Suc k) \ ?pc \ cond \ - (\c. if c then INV' k \ ?pc else \ ()) - \ \ \ \\ - using tau_rho theta_chi - by (meson aentails_refl aentails_trans sstriple_consequence) - } - moreover { - fix k - assume kn: \k < n\ - have \\ ; INV' k \ ?pc \ body \ - (\_. INV k \ ?pc) \ (\r. \ r \ ?pc) \ (\a. \ a \ ?pc)\ - using body_step[OF kn] ucincl_INV' by (intro sstriple_frame_rule; clarsimp) - from this have \\ ; INV' k \ ?pc \ body \ - (\_. INV k \ ?pc) \ \ \ \\ - using tau_rho theta_chi - by (meson aentails_refl sstriple_consequence) - } - ultimately have \\ ; INV n \ ?pc \ bounded_while n cond body \ \ \ \ \ \\ - using sstriple_bounded_while[where INV=\\k. INV k \ ?pc\ and INV'=\\k. INV' k \ ?pc\] - inv0_psi by blast + then show \\ ; INV (Suc k) \ ?pc \ cond \ + (\c. if c then INV' k \ ?pc else INV 0 \ ?pc) \ ?rho \ ?theta\ + proof (rule sstriple_consequence) + fix c + show \(if c then INV' k else INV 0) \ ?pc + \ (if c then INV' k \ ?pc else INV 0 \ ?pc)\ + by (cases c) (simp_all add: aentails_refl) + qed (simp_all add: aentails_refl) + qed + have body_step': \\k. k < n \ + \ ; INV' k \ ?pc \ body \ (\_. INV k \ ?pc) \ ?rho \ ?theta\ + using body_step ucincl_INV' by (intro allI impI sstriple_frame_rule; clarsimp) + have cond_exhaust_raw: \\ ; INV 0 \ ?pc \ cond \ + (\c. (if c then \ else INV 0) \ ?pc) + \ ?rho \ ?theta\ + using cond_exhaust ucincl_INV by (intro sstriple_frame_rule; clarsimp) + have cond_exhaust': \\ ; INV 0 \ ?pc \ cond \ + (\c. if c then \ else INV 0 \ ?pc) + \ ?rho \ ?theta\ + proof (rule sstriple_consequence[OF cond_exhaust_raw]) + show \INV 0 \ ?pc \ INV 0 \ ?pc\ + by (rule aentails_refl) + show \\c. (if c then \ else INV 0) \ ?pc + \ (if c then \ else INV 0 \ ?pc)\ + proof - + fix c + show \(if c then \ else INV 0) \ ?pc + \ (if c then \ else INV 0 \ ?pc)\ + proof (cases c) + case True + then show ?thesis + by (simp add: asepconj_simp bot_aentails_all) + next + case False + then show ?thesis + by (simp add: aentails_refl) + qed + qed + show \\r. ?rho r \ ?rho r\ + proof - + fix r + show \?rho r \ ?rho r\ by (rule aentails_refl) + qed + show \\a. ?theta a \ ?theta a\ + proof - + fix a + show \?theta a \ ?theta a\ by (rule aentails_refl) + qed + qed + have loop0: \\ ; INV n \ ?pc \ bounded_while n cond body \ ?psi0 \ ?rho \ ?theta\ + by (rule sstriple_bounded_while[ + where INV=\\k. INV k \ ?pc\ + and INV'=\\k. INV' k \ ?pc\ + and \=\?psi0\ + and \=\?rho\ + and \=\?theta\, + OF cond_step' body_step' cond_exhaust']) + have \\ ; INV n \ ?pc \ bounded_while n cond body \ \ \ \ \ \\ + proof (rule sstriple_consequence[OF loop0]) + show \INV n \ ?pc \ INV n \ ?pc\ + by (rule aentails_refl) + show \\u. ?psi0 u \ \ u\ + proof - + fix u + have \?psi0 u = INV 0 \ ?pc\ by simp + moreover have \\ u = \ ()\ by (cases u) simp + ultimately show \?psi0 u \ \ u\ + using inv0_psi by simp + qed + show \\r. ?rho r \ \ r\ + using tau_rho . + show \\a. ?theta a \ \ a\ + using theta_chi . + qed then show ?thesis by simp qed diff --git a/Shallow_Separation_Logic/Weakest_Precondition.thy b/Shallow_Separation_Logic/Weakest_Precondition.thy index aef9b3a8..0c4a3295 100644 --- a/Shallow_Separation_Logic/Weakest_Precondition.thy +++ b/Shallow_Separation_Logic/Weakest_Precondition.thy @@ -1050,6 +1050,8 @@ lemma wp_bounded_while_framedI: if c then INV' k else INV 0) \ \\ and \\k. k < n \ INV' k \ \\

\ body (\_. INV k) \ \\ + and \INV 0 \ \\

\ cond (\c. + if c then \ else INV 0) \ \\ shows \\ \ \\

\ (bounded_while n cond body) \ \ \\ proof - let ?pc = \((INV 0 \ \ ()) \ (\r. \ r \ \ r) \ (\r. \ r \ \ r))\