theory Demo05 imports Vcg begin section {* Inductively defined relations *} datatype instr = Init int | Add int | Mul int | Jump string type_synonym state = int type_synonym block = "instr list" type_synonym prog = "string \ block" text {* Execution is tail recursive, by passing the current state along *} fun exec :: "state \ instr list \ state" where "exec s [] = s" | "exec s (Init i # xs) = exec i xs" | "exec s (Add i # xs) = exec (s + i) xs" | "exec s (Mul i # xs) = exec (s * i) xs" text {* Validate *} lemma "exec 0 [ Init 38, Add 4 ] = 42" "exec 38 [ Add 4, Mul 3 ] = 126" by simp+ text {* Problem: we cannot add jumps *} function execp :: "prog \ state \ instr list \ state" where "execp p s [] = s" | "execp p s (Init i # xs) = execp p i xs" | "execp p s (Add i # xs) = execp p (s + i) xs" | "execp p s (Mul i # xs) = execp p (s * i) xs" | "execp p s (Jump l # xs) = (case p l of None \ s | Some xs \ execp p s xs)" by pat_completeness auto text {* Problem: we cannot prove termination, because the Jump may induce infinite loops. Just to see the problem, let's try to prove termination by the number of remaining instructions. *} termination execp apply (relation "measure (\(p,s,xs). length xs)") apply auto[4] txt {* Just the one goal for the Jump case remains *} apply simp txt {* Problem: the block we are jumping to may well be longer than the one we leave. *} oops lemma option_case_mono[mono]: "\ none_case \ none_case'; \y. some_case y \ some_case' y \ \ (case (x :: 'a option) of None \ none_case | Some y \ some_case y) \ (case x of None \ none_case' | Some y \ some_case' y)" by (auto split: option.split) inductive execpp :: "prog \ state \ instr list \ state \ bool" where "s' = s \ execpp p s [] s'" | "execpp p i xs s' \ execpp p s (Init i # xs) s'" | "execpp p (s + i) xs s' \ execpp p s (Add i # xs) s'" | "execpp p (s * i) xs s' \ execpp p s (Mul i # xs) s'" | "\ case p l of Some b \ execpp p s b s' | None \ s' = s \ \ execpp p s (Jump l # xs) s'" thm execpp.cases inductive_cases [elim!]: "execpp p s [] s'" inductive_cases [elim!]: "execpp p s (Init i # xs) s'" inductive_cases [elim!]: "execpp p s (Add i # xs) s'" inductive_cases [elim!]: "execpp p s (Mul i # xs) s'" inductive_cases [elim!]: "execpp p s (Jump l # xs) s'" lemma execpp_determistic: "\ execpp p s xs s'1; execpp p s xs s'2 \ \ s'1 = s'2" apply (induct arbitrary: s'2 rule: execpp.induct) apply (force intro: execpp.intros split: option.split_asm)+ done text {* Validate by execution *} lemma "execpp [ ''b'' \ [ Mul 3 ] ] 14 [ Jump ''b'' ] 42" apply (rule execpp.intros) apply (simp) apply (rule execpp.intros) apply (rule execpp.intros) apply simp done section {* A Glimpse at Verification *} hoarestate vars = A :: nat I :: nat M :: nat N :: nat R :: nat S :: nat fun fac:: "nat \ nat" where "fac 0 = 1" |"fac (Suc n) = (Suc n) * fac n" lemma (in vars) "\\ \\N = 5 * 2\ \N :== (2 * 4) * \N \\N = 80\" apply simp apply vcg apply simp done lemma (in vars) "\\ \\N = 5\ \N :== 2 * \N;; \N :== \N + 1 \\N = 11\" apply vcg apply simp done text {* Note shallow embedding: use any HOL expression in assignment *} lemma (in vars) "\\ \\N = n \ \N :== fac \N \\N = fac n \" apply vcg apply simp done lemma (in vars) "\\ \ True \ IF \N = 0 THEN \M :== 1 ELSE \M :== 2 FI \ if \N = 0 then \M = 1 else \M = 2 \" apply vcg apply simp done text {* Multiplication by addition Inputs are a and b (and those are not modified, so we write them as HOL free variables) *} lemma (in vars) "\,{}\ \ True\ \M :== 0;; \S :== 0;; WHILE \M \ a INV \\S = \M * b\ DO \S :== \S + b;; \M :== \M + 1 OD \\S = a * b\" apply vcg apply auto done procedures Fac (N::nat | R::nat) "IF \N = 0 THEN \R :== 1 ELSE \R :== CALL Fac(\N - 1);; \R :== \N * \R FI" lemma (in Fac_impl) shows "\n. \\ \\N = n\ \R :== PROC Fac(\N) \\R = fac n\" apply (hoare_rule HoarePartial.ProcRec1) apply vcg apply simp apply (case_tac N) apply auto done end