diff -r 0e27325da568 -r 8bcb906e73f2 src/HOL/Hoare/Examples.thy --- a/src/HOL/Hoare/Examples.thy Fri Oct 18 20:48:01 2024 +0200 +++ b/src/HOL/Hoare/Examples.thy Fri Oct 18 21:19:06 2024 +0200 @@ -315,35 +315,36 @@ Ambiguity warnings of parser are due to \:=\ being used both for assignment and list update. \ -lemma lem: "m - Suc 0 < n ==> m < Suc n" -by arith - - lemma Partition: -"[| leq == \A i. \k. k A!k \ pivot; - geq == \A i. \k. i k pivot \ A!k |] ==> - VARS A u l - {0 < length(A::('a::order)list)} - l := 0; u := length A - Suc 0; - WHILE l \ u - INV {leq A l \ geq A u \ u l\length A} - DO WHILE l < length A \ A!l \ pivot - INV {leq A l & geq A u \ u l\length A} - DO l := l+1 OD; - WHILE 0 < u & pivot \ A!u - INV {leq A l & geq A u \ u l\length A} - DO u := u - 1 OD; - IF l \ u THEN A := A[l := A!u, u := A!l] ELSE SKIP FI - OD - {leq A u & (\k. u k A!k = pivot) \ geq A l}" -\ \expand and delete abbreviations first\ -apply (simp) -apply (erule thin_rl)+ -apply vcg_simp - apply (force simp: neq_Nil_conv) - apply (blast elim!: less_SucE intro: Suc_leI) - apply (blast elim!: less_SucE intro: less_imp_diff_less dest: lem) -apply (force simp: nth_list_update) -done + fixes pivot + defines "leq \ \A i. \k. k A!k \ pivot" + and "geq \ \A i. \k. i k pivot \ A!k" + shows + "VARS A u l + {0 < length(A::('a::order)list)} + l := 0; u := length A - Suc 0; + WHILE l \ u + INV {leq A l \ geq A u \ u l\length A} + DO WHILE l < length A \ A!l \ pivot + INV {leq A l & geq A u \ u l\length A} + DO l := l+1 OD; + WHILE 0 < u & pivot \ A!u + INV {leq A l & geq A u \ u l\length A} + DO u := u - 1 OD; + IF l \ u THEN A := A[l := A!u, u := A!l] ELSE SKIP FI + OD + {leq A u & (\k. u k A!k = pivot) \ geq A l}" +proof - + have eq: "m - Suc 0 < n \ m < Suc n" for m n + by arith + show ?thesis + apply (simp add: assms) + apply vcg_simp + apply (force simp: neq_Nil_conv) + apply (blast elim!: less_SucE intro: Suc_leI) + apply (blast elim!: less_SucE intro: less_imp_diff_less dest: eq) + apply (force simp: nth_list_update) + done +qed end