# HG changeset patch # User nipkow # Date 1317196511 -7200 # Node ID 054a9ac0d7ef8ebd015d33e9326dd019a05c9946 # Parent 305f83b6da5473ce1826d39d9decb76d84813969 Added Hoare-like Abstract Interpretation diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int0.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int0.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,101 @@ +(* Author: Tobias Nipkow *) + +theory Abs_Int0 +imports Abs_State +begin + +subsection "Computable Abstract Interpretation" + +text{* Abstract interpretation over type @{text astate} instead of +functions. *} + +locale Abs_Int = Val_abs + +fixes pfp :: "('a st up acom \ 'a st up acom) \ 'a st up acom \ 'a st up acom" +assumes pfp: "\c. strip(f c) = strip c \ f(pfp f c) \ pfp f c" +and strip_pfp: "\c. strip(f c) = strip c \ strip(pfp f c) = strip c" +begin + +fun aval' :: "aexp \ 'a st \ 'a" where +"aval' (N n) _ = num' n" | +"aval' (V x) S = lookup S x" | +"aval' (Plus a1 a2) S = plus' (aval' a1 S) (aval' a2 S)" + +fun step :: "'a st up \ 'a st up acom \ 'a st up acom" where +"step S (SKIP {P}) = (SKIP {S})" | +"step S (x ::= e {P}) = + x ::= e {case S of Bot \ Bot | Up S \ Up(update S x (aval' e S))}" | +"step S (c1; c2) = step S c1; step (post c1) c2" | +"step S (IF b THEN c1 ELSE c2 {P}) = + (let c1' = step S c1; c2' = step S c2 + in IF b THEN c1' ELSE c2' {post c1 \ post c2})" | +"step S ({Inv} WHILE b DO c {P}) = + {S \ post c} WHILE b DO step Inv c {Inv}" + +lemma strip_step[simp]: "strip(step S c) = strip c" +by(induct c arbitrary: S) (simp_all add: Let_def) + +definition AI :: "com \ 'a st up acom" where +"AI c = pfp (step Top) (bot_acom c)" + + +subsubsection "Monotonicity" + +lemma mono_aval': "S \ S' \ aval' e S \ aval' e S'" +by(induction e) (auto simp: le_st_def lookup_def mono_plus') + +lemma mono_update: "a \ a' \ S \ S' \ update S x a \ update S' x a'" +by(auto simp add: le_st_def lookup_def update_def) + +lemma step_mono: "S \ S' \ step S c \ step S' c" +apply(induction c arbitrary: S S') +apply (auto simp: Let_def mono_update mono_aval' le_join_disj split: up.split) +done + +subsubsection "Soundness" + +lemma aval'_sound: "s <:f S \ aval a s <: aval' a S" +by (induct a) (auto simp: rep_num' rep_plus' rep_st_def lookup_def) + +lemma in_rep_update: "\ s <:f S; i <: a \ \ s(x := i) <:f update S x a" +by(simp add: rep_st_def lookup_update) + +lemma step_sound: + "step S c \ c \ (strip c,s) \ t \ s <:up S \ t <:up post c" +proof(induction c arbitrary: S s t) + case SKIP thus ?case + by simp (metis skipE up_fun_in_rep_le) +next + case Assign thus ?case + apply (auto simp del: fun_upd_apply simp: split: up.splits) + by (metis aval'_sound fun_in_rep_le in_rep_update) +next + case Semi thus ?case by simp blast +next + case (If b c1 c2 S0) thus ?case + apply(auto simp: Let_def) + apply (metis up_fun_in_rep_le)+ + done +next + case (While Inv b c P) + from While.prems have inv: "step Inv c \ c" + and "post c \ Inv" and "S \ Inv" and "Inv \ P" by(auto simp: Let_def) + { fix s t have "(WHILE b DO strip c,s) \ t \ s <:up Inv \ t <:up Inv" + proof(induction "WHILE b DO strip c" s t rule: big_step_induct) + case WhileFalse thus ?case by simp + next + case (WhileTrue s1 s2 s3) + from WhileTrue.hyps(5)[OF up_fun_in_rep_le[OF While.IH[OF inv `(strip c, s1) \ s2` `s1 <:up Inv`] `post c \ Inv`]] + show ?case . + qed + } + thus ?case using While.prems(2) + by simp (metis `s <:up S` `S \ Inv` `Inv \ P` up_fun_in_rep_le) +qed + +lemma AI_sound: "(c,s) \ t \ t <:up post(AI c)" +by(fastforce simp: AI_def strip_pfp in_rep_Top_up intro: step_sound pfp) + +end + + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int0_const.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int0_const.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,150 @@ +(* Author: Tobias Nipkow *) + +theory Abs_Int0_const +imports Abs_Int0 +begin + +subsection "Constant Propagation" + +datatype cval = Const val | Any + +fun rep_cval where +"rep_cval (Const n) = {n}" | +"rep_cval (Any) = UNIV" + +fun plus_cval where +"plus_cval (Const m) (Const n) = Const(m+n)" | +"plus_cval _ _ = Any" + +lemma plus_cval_cases: "plus_cval a1 a2 = + (case (a1,a2) of (Const m, Const n) \ Const(m+n) | _ \ Any)" +by(auto split: prod.split cval.split) + +instantiation cval :: SL_top +begin + +fun le_cval where +"_ \ Any = True" | +"Const n \ Const m = (n=m)" | +"Any \ Const _ = False" + +fun join_cval where +"Const m \ Const n = (if n=m then Const m else Any)" | +"_ \ _ = Any" + +definition "\ = Any" + +instance +proof + case goal1 thus ?case by (cases x) simp_all +next + case goal2 thus ?case by(cases z, cases y, cases x, simp_all) +next + case goal3 thus ?case by(cases x, cases y, simp_all) +next + case goal4 thus ?case by(cases y, cases x, simp_all) +next + case goal5 thus ?case by(cases z, cases y, cases x, simp_all) +next + case goal6 thus ?case by(simp add: Top_cval_def) +qed + +end + +interpretation Rep rep_cval +proof + case goal1 thus ?case + by(cases a, cases b, simp, simp, cases b, simp, simp) +next + case goal2 show ?case by(simp add: Top_cval_def) +qed + +interpretation Val_abs rep_cval Const plus_cval +proof + case goal1 show ?case by simp +next + case goal2 thus ?case + by(auto simp: plus_cval_cases split: cval.split) +next + case goal3 thus ?case + by(auto simp: plus_cval_cases split: cval.split) +qed + +text{* Could set the limit of the number of iterations to an arbitrarily +large number because all ascending chains in this semilattice are finite. *} + +interpretation Abs_Int rep_cval Const plus_cval "(iter 15)" +defines AI_const is AI +and aval'_const is aval' +and step_const is step +proof qed (auto simp: iter_pfp strip_iter) + +text{* Straight line code: *} +definition "test1_const = + ''y'' ::= N 7; + ''z'' ::= Plus (V ''y'') (N 2); + ''y'' ::= Plus (V ''x'') (N 0)" + +text{* Conditional: *} +definition "test2_const = + IF Less (N 41) (V ''x'') THEN ''x'' ::= N 5 ELSE ''x'' ::= N 5" + +text{* Conditional, test is ignored: *} +definition "test3_const = + ''x'' ::= N 42; + IF Less (N 41) (V ''x'') THEN ''x'' ::= N 5 ELSE ''x'' ::= N 6" + +text{* While: *} +definition "test4_const = + ''x'' ::= N 0; WHILE B True DO ''x'' ::= N 0" + +text{* While, test is ignored: *} +definition "test5_const = + ''x'' ::= N 0; WHILE Less (V ''x'') (N 1) DO ''x'' ::= N 1" + +text{* Iteration is needed: *} +definition "test6_const = + ''x'' ::= N 0; ''y'' ::= N 0; ''z'' ::= N 2; + WHILE Less (V ''x'') (N 1) DO (''x'' ::= V ''y''; ''y'' ::= V ''z'')" + +text{* More iteration would be needed: *} +definition "test7_const = + ''x'' ::= N 0; ''y'' ::= N 0; ''z'' ::= N 0; ''u'' ::= N 3; + WHILE Less (V ''x'') (N 1) + DO (''x'' ::= V ''y''; ''y'' ::= V ''z''; ''z'' ::= V ''u'')" + +text{* For readability: *} +translations "x" <= "CONST V x" +translations "x" <= "CONST N x" +translations "x" <= "CONST Const x" +translations "x < y" <= "CONST Less x y" +translations "x" <= "CONST B x" +translations "x" <= "CONST Up x" + +value [code] "show_acom (((step_const \)^^0) (\\<^sub>c test1_const))" +value [code] "show_acom (((step_const \)^^1) (\\<^sub>c test1_const))" +value [code] "show_acom (((step_const \)^^2) (\\<^sub>c test1_const))" +value [code] "show_acom (((step_const \)^^3) (\\<^sub>c test1_const))" +value [code] "show_acom (AI_const test1_const)" + +value [code] "show_acom (AI_const test2_const)" +value [code] "show_acom (AI_const test3_const)" + +value [code] "show_acom (((step_const \)^^0) (\\<^sub>c test4_const))" +value [code] "show_acom (((step_const \)^^1) (\\<^sub>c test4_const))" +value [code] "show_acom (((step_const \)^^2) (\\<^sub>c test4_const))" +value [code] "show_acom (((step_const \)^^3) (\\<^sub>c test4_const))" +value [code] "show_acom (AI_const test4_const)" + +value [code] "show_acom (((step_const \)^^0) (\\<^sub>c test5_const))" +value [code] "show_acom (((step_const \)^^1) (\\<^sub>c test5_const))" +value [code] "show_acom (((step_const \)^^2) (\\<^sub>c test5_const))" +value [code] "show_acom (((step_const \)^^3) (\\<^sub>c test5_const))" +value [code] "show_acom (((step_const \)^^4) (\\<^sub>c test5_const))" +value [code] "show_acom (((step_const \)^^5) (\\<^sub>c test5_const))" +value [code] "show_acom (AI_const test5_const)" + +value [code] "show_acom (AI_const test6_const)" +value [code] "show_acom (AI_const test7_const)" + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int0_fun.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int0_fun.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,423 @@ +(* Author: Tobias Nipkow *) + +header "Abstract Interpretation" + +theory Abs_Int0_fun +imports "~~/src/HOL/ex/Interpretation_with_Defs" Big_Step +begin + +subsection "Annotated Commands" + +datatype 'a acom = + SKIP 'a ("SKIP {_}") | + Assign name aexp 'a ("(_ ::= _/ {_})" [1000, 61, 0] 61) | + Semi "'a acom" "'a acom" ("_;// _" [60, 61] 60) | + If bexp "'a acom" "'a acom" 'a + ("((IF _/ THEN _/ ELSE _)/ {_})" [0, 0, 61, 0] 61) | + While 'a bexp "'a acom" 'a + ("({_}// WHILE _/ DO (_)// {_})" [0, 0, 61, 0] 61) + +fun post :: "'a acom \'a" where +"post (SKIP {P}) = P" | +"post (x ::= e {P}) = P" | +"post (c1; c2) = post c2" | +"post (IF b THEN c1 ELSE c2 {P}) = P" | +"post ({Inv} WHILE b DO c {P}) = P" + +fun strip :: "'a acom \ com" where +"strip (SKIP {a}) = com.SKIP" | +"strip (x ::= e {a}) = (x ::= e)" | +"strip (c1;c2) = (strip c1; strip c2)" | +"strip (IF b THEN c1 ELSE c2 {a}) = (IF b THEN strip c1 ELSE strip c2)" | +"strip ({a1} WHILE b DO c {a2}) = (WHILE b DO strip c)" + +fun anno :: "'a \ com \ 'a acom" where +"anno a com.SKIP = SKIP {a}" | +"anno a (x ::= e) = (x ::= e {a})" | +"anno a (c1;c2) = (anno a c1; anno a c2)" | +"anno a (IF b THEN c1 ELSE c2) = + (IF b THEN anno a c1 ELSE anno a c2 {a})" | +"anno a (WHILE b DO c) = + ({a} WHILE b DO anno a c {a})" + +lemma strip_anno[simp]: "strip (anno a c) = c" +by(induct c) simp_all + +fun map_acom :: "('a \ 'b) \ 'a acom \ 'b acom" where +"map_acom f (SKIP {a}) = SKIP {f a}" | +"map_acom f (x ::= e {a}) = (x ::= e {f a})" | +"map_acom f (c1;c2) = (map_acom f c1; map_acom f c2)" | +"map_acom f (IF b THEN c1 ELSE c2 {a}) = + (IF b THEN map_acom f c1 ELSE map_acom f c2 {f a})" | +"map_acom f ({a1} WHILE b DO c {a2}) = + ({f a1} WHILE b DO map_acom f c {f a2})" + + +subsection "Orderings" + +class preord = +fixes le :: "'a \ 'a \ bool" (infix "\" 50) +assumes le_refl[simp]: "x \ x" +and le_trans: "x \ y \ y \ z \ x \ z" +begin + +definition mono where "mono f = (\x y. x \ y \ f x \ f y)" + +lemma monoD: "mono f \ x \ y \ f x \ f y" by(simp add: mono_def) + +lemma mono_comp: "mono f \ mono g \ mono (g o f)" +by(simp add: mono_def) + +declare le_trans[trans] + +end + +text{* Note: no antisymmetry. Allows implementations where some abstract +element is implemented by two different values @{prop "x \ y"} +such that @{prop"x \ y"} and @{prop"y \ x"}. Antisymmetry is not +needed because we never compare elements for equality but only for @{text"\"}. +*} + +class SL_top = preord + +fixes join :: "'a \ 'a \ 'a" (infixl "\" 65) +fixes Top :: "'a" ("\") +assumes join_ge1 [simp]: "x \ x \ y" +and join_ge2 [simp]: "y \ x \ y" +and join_least: "x \ z \ y \ z \ x \ y \ z" +and top[simp]: "x \ \" +begin + +lemma join_le_iff[simp]: "x \ y \ z \ x \ z \ y \ z" +by (metis join_ge1 join_ge2 join_least le_trans) + +lemma le_join_disj: "x \ y \ x \ z \ x \ y \ z" +by (metis join_ge1 join_ge2 le_trans) + +end + +instantiation "fun" :: (type, SL_top) SL_top +begin + +definition "f \ g = (ALL x. f x \ g x)" +definition "f \ g = (\x. f x \ g x)" +definition "\ = (\x. \)" + +lemma join_apply[simp]: "(f \ g) x = f x \ g x" +by (simp add: join_fun_def) + +instance +proof + case goal2 thus ?case by (metis le_fun_def preord_class.le_trans) +qed (simp_all add: le_fun_def Top_fun_def) + +end + + +instantiation acom :: (preord) preord +begin + +fun le_acom :: "('a::preord)acom \ 'a acom \ bool" where +"le_acom (SKIP {S}) (SKIP {S'}) = (S \ S')" | +"le_acom (x ::= e {S}) (x' ::= e' {S'}) = (x=x' \ e=e' \ S \ S')" | +"le_acom (c1;c2) (c1';c2') = (le_acom c1 c1' \ le_acom c2 c2')" | +"le_acom (IF b THEN c1 ELSE c2 {S}) (IF b' THEN c1' ELSE c2' {S'}) = + (b=b' \ le_acom c1 c1' \ le_acom c2 c2' \ S \ S')" | +"le_acom ({Inv} WHILE b DO c {P}) ({Inv'} WHILE b' DO c' {P'}) = + (b=b' \ le_acom c c' \ Inv \ Inv' \ P \ P')" | +"le_acom _ _ = False" + +lemma [simp]: "SKIP {S} \ c \ (\S'. c = SKIP {S'} \ S \ S')" +by (cases c) auto + +lemma [simp]: "x ::= e {S} \ c \ (\S'. c = x ::= e {S'} \ S \ S')" +by (cases c) auto + +lemma [simp]: "c1;c2 \ c \ (\c1' c2'. c = c1';c2' \ c1 \ c1' \ c2 \ c2')" +by (cases c) auto + +lemma [simp]: "IF b THEN c1 ELSE c2 {S} \ c \ + (\c1' c2' S'. c = IF b THEN c1' ELSE c2' {S'} \ c1 \ c1' \ c2 \ c2' \ S \ S')" +by (cases c) auto + +lemma [simp]: "{Inv} WHILE b DO c {P} \ w \ + (\Inv' c' P'. w = {Inv'} WHILE b DO c' {P'} \ c \ c' \ Inv \ Inv' \ P \ P')" +by (cases w) auto + +instance +proof + case goal1 thus ?case by (induct x) auto +next + case goal2 thus ?case + apply(induct x y arbitrary: z rule: le_acom.induct) + apply (auto intro: le_trans) + done +qed + +end + +definition Top_acom :: "com \ ('a::SL_top) acom" ("\\<^sub>c") where +"\\<^sub>c = anno \" + +lemma strip_Top_acom[simp]: "strip (\\<^sub>c c) = c" +by(simp add: Top_acom_def) + +lemma le_Top_acomp[simp]: "strip c' = c \ c' \ \\<^sub>c c" +by(induct c' arbitrary: c) (auto simp: Top_acom_def) + + +subsubsection "Lifting" + +datatype 'a up = Bot | Up 'a + +instantiation up :: (SL_top)SL_top +begin + +fun le_up where +"Up x \ Up y = (x \ y)" | +"Bot \ y = True" | +"Up _ \ Bot = False" + +lemma [simp]: "(x \ Bot) = (x = Bot)" +by (cases x) simp_all + +lemma [simp]: "(Up x \ u) = (\y. u = Up y & x \ y)" +by (cases u) auto + +fun join_up where +"Up x \ Up y = Up(x \ y)" | +"Bot \ y = y" | +"x \ Bot = x" + +lemma [simp]: "x \ Bot = x" +by (cases x) simp_all + +definition "\ = Up \" + +instance proof + case goal1 show ?case by(cases x, simp_all) +next + case goal2 thus ?case + by(cases z, simp, cases y, simp, cases x, auto intro: le_trans) +next + case goal3 thus ?case by(cases x, simp, cases y, simp_all) +next + case goal4 thus ?case by(cases y, simp, cases x, simp_all) +next + case goal5 thus ?case by(cases z, simp, cases y, simp, cases x, simp_all) +next + case goal6 thus ?case by(cases x, simp_all add: Top_up_def) +qed + +end + +definition bot_acom :: "com \ ('a::SL_top)up acom" ("\\<^sub>c") where +"\\<^sub>c = anno Bot" + +lemma strip_bot_acom[simp]: "strip(\\<^sub>c c) = c" +by(simp add: bot_acom_def) + + +subsection "Absract Interpretation" + +text{* The representation of abstract by a set of concrete values: *} + +locale Rep = +fixes rep :: "'a::SL_top \ 'b set" +assumes le_rep: "a \ b \ rep a \ rep b" +and rep_Top: "rep \ = UNIV" +begin + +abbreviation in_rep (infix "<:" 50) where "x <: a == x : rep a" + +lemma in_rep_Top[simp]: "x <: \" +by(simp add: rep_Top) + +end + +definition rep_fun :: "('a \ 'b set) \ ('c \ 'a) \ ('c \ 'b)set" where +"rep_fun rep F = {f. \x. f x \ rep(F x)}" + +fun rep_up :: "('a \ 'b set) \ 'a up \ 'b set" where +"rep_up rep Bot = {}" | +"rep_up rep (Up a) = rep a" + +text{* The interface for abstract values: *} + +(* FIXME: separate Rep interface needed? *) +locale Val_abs = Rep rep for rep :: "'a::SL_top \ val set" + +fixes num' :: "val \ 'a" +and plus' :: "'a \ 'a \ 'a" +assumes rep_num': "n <: num' n" +and rep_plus': "n1 <: a1 \ n2 <: a2 \ n1+n2 <: plus' a1 a2" +and mono_plus': "a1 \ b1 \ a2 \ b2 \ plus' a1 a2 \ plus' b1 b2" + + +subsubsection "Post-fixed point iteration" + +fun iter :: "nat \ (('a::SL_top) acom \ 'a acom) \ 'a acom \ 'a acom" where +"iter 0 f c = \\<^sub>c (strip c)" | +"iter (Suc n) f c = (let fc = f c in if fc \ c then c else iter n f fc)" +(* code lemma?? *) + +lemma strip_iter: assumes "\c. strip(f c) = strip c" +shows "strip(iter n f c) = strip c" +apply (induction n arbitrary: c) + apply (metis iter.simps(1) strip_Top_acom) +apply (simp add:Let_def) +by (metis assms) + +lemma iter_pfp: assumes "\c. strip(f c) = strip c" +shows "f(iter n f c) \ iter n f c" +apply (induction n arbitrary: c) + apply(simp add: assms) +apply (simp add:Let_def) +done + +lemma iter_funpow: assumes "\c. strip(f c) = strip c" +shows "iter n f x \ \\<^sub>c (strip x) \ \k. iter n f x = (f^^k) x" +apply(induction n arbitrary: x) + apply simp +apply (auto simp: Let_def assms) + apply(metis funpow.simps(1) id_def) +by (metis assms funpow.simps(2) funpow_swap1 o_apply) + +text{* For monotone @{text f}, @{term "iter f n x0"} yields the least +post-fixed point above @{text x0}, unless it yields @{text Top}. *} + +lemma iter_least_pfp: +assumes strip: "\c. strip(f c) = strip c" +and mono: "\x y. x \ y \ f x \ f y" +and not_top: "iter n f x0 \ \\<^sub>c (strip x0)" +and "f p \ p" and "x0 \ p" shows "iter n f x0 \ p" +proof- + obtain k where "iter n f x0 = (f^^k) x0" + using iter_funpow[OF strip not_top] by blast + moreover + { fix n have "(f^^n) x0 \ p" + proof(induction n) + case 0 show ?case by(simp add: `x0 \ p`) + next + case (Suc n) thus ?case + by (simp add: `x0 \ p`)(metis Suc `f p \ p` le_trans mono) + qed + } ultimately show ?thesis by simp +qed + +type_synonym 'a st = "(name \ 'a)" + +locale Abs_Int_Fun = Val_abs + +fixes pfp :: "('a st up acom \ 'a st up acom) \ 'a st up acom \ 'a st up acom" +assumes pfp: "f(pfp f c) \ pfp f c" +and strip_pfp: "\c. strip(f c) = strip c \ strip(pfp f c) = strip c" +begin + +fun aval' :: "aexp \ 'a st \ 'a" where +"aval' (N n) _ = num' n" | +"aval' (V x) S = S x" | +"aval' (Plus a1 a2) S = plus' (aval' a1 S) (aval' a2 S)" + +fun step :: "'a st up \ 'a st up acom \ 'a st up acom" where +"step S (SKIP {P}) = (SKIP {S})" | +"step S (x ::= e {P}) = + x ::= e {case S of Bot \ Bot | Up S \ Up(S(x := aval' e S))}" | +"step S (c1; c2) = step S c1; step (post c1) c2" | +"step S (IF b THEN c1 ELSE c2 {P}) = + (let c1' = step S c1; c2' = step S c2 + in IF b THEN c1' ELSE c2' {post c1 \ post c2})" | +"step S ({Inv} WHILE b DO c {P}) = + {S \ post c} WHILE b DO (step Inv c) {Inv}" + +lemma strip_step[simp]: "strip(step S c) = strip c" +by(induct c arbitrary: S) (simp_all add: Let_def) + + +definition AI :: "com \ 'a st up acom" where +"AI c = pfp (step \) (\\<^sub>c c)" + + +abbreviation fun_in_rep :: "state \ 'a st \ bool" (infix "<:f" 50) where +"s <:f S == s \ rep_fun rep S" + +notation fun_in_rep (infix "<:\<^sub>f" 50) + +lemma fun_in_rep_le: "s <:f S \ S \ T \ s <:f T" +by(auto simp add: rep_fun_def le_fun_def dest: le_rep) + +abbreviation up_in_rep :: "state \ 'a st up \ bool" (infix "<:up" 50) where +"s <:up S == s : rep_up (rep_fun rep) S" + +notation (output) up_in_rep (infix "<:\<^sub>u\<^sub>p" 50) + +lemma up_fun_in_rep_le: "s <:up S \ S \ T \ s <:up T" +by (cases S) (auto intro:fun_in_rep_le) + +lemma in_rep_Top_fun: "s <:f Top" +by(simp add: Top_fun_def rep_fun_def) + +lemma in_rep_Top_up: "s <:up Top" +by(simp add: Top_up_def in_rep_Top_fun) + + +subsubsection "Monotonicity" + +lemma mono_aval': "S \ S' \ aval' e S \ aval' e S'" +by(induction e)(auto simp: le_fun_def mono_plus') + +lemma mono_update: "a \ a' \ S \ S' \ S(x := a) \ S'(x := a')" +by(simp add: le_fun_def) + +lemma step_mono: "S \ S' \ step S c \ step S' c" +apply(induction c arbitrary: S S') +apply (auto simp: Let_def mono_update mono_aval' le_join_disj split: up.split) +done + +subsubsection "Soundness" + +lemma aval'_sound: "s <:f S \ aval a s <: aval' a S" +by (induct a) (auto simp: rep_num' rep_plus' rep_fun_def) + +lemma in_rep_update: "\ s <:f S; i <: a \ \ s(x := i) <:f S(x := a)" +by(simp add: rep_fun_def) + +lemma step_sound: + "step S c \ c \ (strip c,s) \ t \ s <:up S \ t <:up post c" +proof(induction c arbitrary: S s t) + case SKIP thus ?case + by simp (metis skipE up_fun_in_rep_le) +next + case Assign thus ?case + apply (auto simp del: fun_upd_apply split: up.splits) + by (metis aval'_sound fun_in_rep_le in_rep_update) +next + case Semi thus ?case by simp blast +next + case (If b c1 c2 S0) thus ?case + apply(auto simp: Let_def) + apply (metis up_fun_in_rep_le)+ + done +next + case (While Inv b c P) + from While.prems have inv: "step Inv c \ c" + and "post c \ Inv" and "S \ Inv" and "Inv \ P" by(auto simp: Let_def) + { fix s t have "(WHILE b DO strip c,s) \ t \ s <:up Inv \ t <:up Inv" + proof(induction "WHILE b DO strip c" s t rule: big_step_induct) + case WhileFalse thus ?case by simp + next + case (WhileTrue s1 s2 s3) + from WhileTrue.hyps(5)[OF up_fun_in_rep_le[OF While.IH[OF inv `(strip c, s1) \ s2` `s1 <:up Inv`] `post c \ Inv`]] + show ?case . + qed + } + thus ?case using While.prems(2) + by simp (metis `s <:up S` `S \ Inv` `Inv \ P` up_fun_in_rep_le) +qed + +lemma AI_sound: "(c,s) \ t \ t <:up post(AI c)" +by(auto simp: AI_def strip_pfp in_rep_Top_up intro: step_sound pfp) + +end + +text{* Problem: not executable because of the comparison of abstract states, +i.e. functions, in the post-fixedpoint computation. *} + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int1.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int1.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,266 @@ +(* Author: Tobias Nipkow *) + +theory Abs_Int1 +imports Abs_Int0_const +begin + +instantiation prod :: (preord,preord) preord +begin + +definition "le_prod p1 p2 = (fst p1 \ fst p2 \ snd p1 \ snd p2)" + +instance +proof + case goal1 show ?case by(simp add: le_prod_def) +next + case goal2 thus ?case unfolding le_prod_def by(metis le_trans) +qed + +end + + +subsection "Backward Analysis of Expressions" + +hide_const bot + +class L_top_bot = SL_top + +fixes meet :: "'a \ 'a \ 'a" (infixl "\" 65) +and bot :: "'a" ("\") +assumes meet_le1 [simp]: "x \ y \ x" +and meet_le2 [simp]: "x \ y \ y" +and meet_greatest: "x \ y \ x \ z \ x \ y \ z" +assumes bot[simp]: "\ \ x" + +locale Rep1 = Rep rep for rep :: "'a::L_top_bot \ 'b set" + +assumes inter_rep_subset_rep_meet: "rep a1 \ rep a2 \ rep(a1 \ a2)" + -- "this means the meet is precise" +and rep_Bot: "rep \ = {}" +begin + +lemma in_rep_meet: "x <: a1 \ x <: a2 \ x <: a1 \ a2" +by (metis IntI inter_rep_subset_rep_meet set_mp) + +lemma rep_meet[simp]: "rep(a1 \ a2) = rep a1 \ rep a2" +by (metis equalityI inter_rep_subset_rep_meet le_inf_iff le_rep meet_le1 meet_le2) + +lemma mono_meet: "x \ x' \ y \ y' \ x \ y \ x' \ y'" +by (metis meet_greatest meet_le1 meet_le2 le_trans) + +end + + +locale Val_abs1 = Val_abs rep num' plus' + Rep1 rep + for rep :: "'a::L_top_bot \ int set" and num' plus' + +fixes filter_plus' :: "'a \ 'a \ 'a \ 'a * 'a" +and filter_less' :: "bool \ 'a \ 'a \ 'a * 'a" +assumes filter_plus': "filter_plus' a a1 a2 = (a1',a2') \ + n1 <: a1 \ n2 <: a2 \ n1+n2 <: a \ n1 <: a1' \ n2 <: a2'" +and filter_less': "filter_less' (n1 + n1 <: a1 \ n2 <: a2 \ n1 <: a1' \ n2 <: a2'" +and mono_filter_plus': "a1 \ b1 \ a2 \ b2 \ r \ r' \ + filter_plus' r a1 a2 \ filter_plus' r' b1 b2" +and mono_filter_less': "a1 \ b1 \ a2 \ b2 \ + filter_less' bv a1 a2 \ filter_less' bv b1 b2" + +locale Abs_Int1 = Val_abs1 + +fixes pfp :: "('a st up acom \ 'a st up acom) \ 'a st up acom \ 'a st up acom" +assumes pfp: "\c. strip(f c) = strip c \ mono f \ f(pfp f c) \ pfp f c" +and strip_pfp: "\c. strip(f c) = strip c \ strip(pfp f c) = strip c" +begin + +lemma in_rep_join_UpI: "s <:up S1 | s <:up S2 \ s <:up S1 \ S2" +by (metis join_ge1 join_ge2 up_fun_in_rep_le) + +fun aval' :: "aexp \ 'a st up \ 'a" where +"aval' _ Bot = \" | +"aval' (N n) _ = num' n" | +"aval' (V x) (Up S) = lookup S x" | +"aval' (Plus a1 a2) S = plus' (aval' a1 S) (aval' a2 S)" + +lemma aval'_sound: "s <:up S \ aval a s <: aval' a S" +by (induct a)(auto simp: rep_num' rep_plus' in_rep_up_iff lookup_def rep_st_def) + +fun afilter :: "aexp \ 'a \ 'a st up \ 'a st up" where +"afilter (N n) a S = (if n <: a then S else Bot)" | +"afilter (V x) a S = (case S of Bot \ Bot | Up S \ + let a' = lookup S x \ a in + if a' \ \ then Bot else Up(update S x a'))" | +"afilter (Plus e1 e2) a S = + (let (a1,a2) = filter_plus' a (aval' e1 S) (aval' e2 S) + in afilter e1 a1 (afilter e2 a2 S))" + +text{* The test for @{const Bot} in the @{const V}-case is important: @{const +Bot} indicates that a variable has no possible values, i.e.\ that the current +program point is unreachable. But then the abstract state should collapse to +@{const bot}. Put differently, we maintain the invariant that in an abstract +state all variables are mapped to non-@{const Bot} values. Otherwise the +(pointwise) join of two abstract states, one of which contains @{const Bot} +values, may produce too large a result, thus making the analysis less +precise. *} + + +fun bfilter :: "bexp \ bool \ 'a st up \ 'a st up" where +"bfilter (B bv) res S = (if bv=res then S else Bot)" | +"bfilter (Not b) res S = bfilter b (\ res) S" | +"bfilter (And b1 b2) res S = + (if res then bfilter b1 True (bfilter b2 True S) + else bfilter b1 False S \ bfilter b2 False S)" | +"bfilter (Less e1 e2) res S = + (let (res1,res2) = filter_less' res (aval' e1 S) (aval' e2 S) + in afilter e1 res1 (afilter e2 res2 S))" + +lemma afilter_sound: "s <:up S \ aval e s <: a \ s <:up afilter e a S" +proof(induction e arbitrary: a S) + case N thus ?case by simp +next + case (V x) + obtain S' where "S = Up S'" and "s <:f S'" using `s <:up S` + by(auto simp: in_rep_up_iff) + moreover hence "s x <: lookup S' x" by(simp add: rep_st_def) + moreover have "s x <: a" using V by simp + ultimately show ?case using V(1) + by(simp add: lookup_update Let_def rep_st_def) + (metis le_rep emptyE in_rep_meet rep_Bot subset_empty) +next + case (Plus e1 e2) thus ?case + using filter_plus'[OF _ aval'_sound[OF Plus(3)] aval'_sound[OF Plus(3)]] + by (auto split: prod.split) +qed + +lemma bfilter_sound: "s <:up S \ bv = bval b s \ s <:up bfilter b bv S" +proof(induction b arbitrary: S bv) + case B thus ?case by simp +next + case (Not b) thus ?case by simp +next + case (And b1 b2) thus ?case by(fastforce simp: in_rep_join_UpI) +next + case (Less e1 e2) thus ?case + by (auto split: prod.split) + (metis afilter_sound filter_less' aval'_sound Less) +qed + + +fun step :: "'a st up \ 'a st up acom \ 'a st up acom" where +"step S (SKIP {P}) = (SKIP {S})" | +"step S (x ::= e {P}) = + x ::= e {case S of Bot \ Bot + | Up S \ Up(update S x (aval' e (Up S)))}" | +"step S (c1; c2) = step S c1; step (post c1) c2" | +"step S (IF b THEN c1 ELSE c2 {P}) = + (let c1' = step (bfilter b True S) c1; c2' = step (bfilter b False S) c2 + in IF b THEN c1' ELSE c2' {post c1 \ post c2})" | +"step S ({Inv} WHILE b DO c {P}) = + {S \ post c} + WHILE b DO step (bfilter b True Inv) c + {bfilter b False Inv}" + +lemma strip_step[simp]: "strip(step S c) = strip c" +by(induct c arbitrary: S) (simp_all add: Let_def) + + +definition AI :: "com \ 'a st up acom" where +"AI c = pfp (step \) (\\<^sub>c c)" + + +subsubsection "Monotonicity" + +lemma mono_aval': "S \ S' \ aval' e S \ aval' e S'" +apply(cases S) + apply simp +apply(cases S') + apply simp +apply simp +by(induction e) (auto simp: le_st_def lookup_def mono_plus') + +lemma mono_afilter: "r \ r' \ S \ S' \ afilter e r S \ afilter e r' S'" +apply(induction e arbitrary: r r' S S') +apply(auto simp: Let_def split: up.splits prod.splits) +apply (metis le_rep subsetD) +apply(drule_tac x = "list" in mono_lookup) +apply (metis mono_meet le_trans) +apply (metis mono_meet mono_lookup mono_update le_trans) +apply(metis mono_aval' mono_filter_plus'[simplified le_prod_def] fst_conv snd_conv) +done + +lemma mono_bfilter: "S \ S' \ bfilter b r S \ bfilter b r S'" +apply(induction b arbitrary: r S S') +apply(auto simp: le_trans[OF _ join_ge1] le_trans[OF _ join_ge2] split: prod.splits) +apply(metis mono_aval' mono_afilter mono_filter_less'[simplified le_prod_def] fst_conv snd_conv) +done + + +lemma post_le_post: "c \ c' \ post c \ post c'" +by (induction c c' rule: le_acom.induct) simp_all + +lemma mono_step: "S \ S' \ c \ c' \ step S c \ step S' c'" +apply(induction c c' arbitrary: S S' rule: le_acom.induct) +apply (auto simp: post_le_post Let_def mono_bfilter mono_update mono_aval' le_join_disj + split: up.split) +done + + +subsubsection "Soundness" + +lemma in_rep_update: "\ s <:f S; i <: a \ \ s(x := i) <:f update S x a" +by(simp add: rep_st_def lookup_update) + +lemma While_final_False: "(WHILE b DO c, s) \ t \ \ bval b t" +by(induct "WHILE b DO c" s t rule: big_step_induct) simp_all + +lemma step_sound: + "step S c \ c \ (strip c,s) \ t \ s <:up S \ t <:up post c" +proof(induction c arbitrary: S s t) + case SKIP thus ?case + by simp (metis skipE up_fun_in_rep_le) +next + case Assign thus ?case + apply (auto simp del: fun_upd_apply split: up.splits) + by (metis aval'_sound fun_in_rep_le in_rep_update rep_up.simps(2)) +next + case Semi thus ?case by simp blast +next + case (If b c1 c2 S0) + show ?case + proof cases + assume "bval b s" + with If.prems have 1: "step (bfilter b True S) c1 \ c1" + and 2: "(strip c1, s) \ t" and 3: "post c1 \ S0" by(auto simp: Let_def) + from If.IH(1)[OF 1 2 bfilter_sound[OF `s <:up S`]] `bval b s` 3 + show ?thesis by simp (metis up_fun_in_rep_le) + next + assume "\ bval b s" + with If.prems have 1: "step (bfilter b False S) c2 \ c2" + and 2: "(strip c2, s) \ t" and 3: "post c2 \ S0" by(auto simp: Let_def) + from If.IH(2)[OF 1 2 bfilter_sound[OF `s <:up S`]] `\ bval b s` 3 + show ?thesis by simp (metis up_fun_in_rep_le) + qed +next + case (While Inv b c P) + from While.prems have inv: "step (bfilter b True Inv) c \ c" + and "post c \ Inv" and "S \ Inv" and "bfilter b False Inv \ P" + by(auto simp: Let_def) + { fix s t have "(WHILE b DO strip c,s) \ t \ s <:up Inv \ t <:up Inv" + proof(induction "WHILE b DO strip c" s t rule: big_step_induct) + case WhileFalse thus ?case by simp + next + case (WhileTrue s1 s2 s3) + from WhileTrue.hyps(5)[OF up_fun_in_rep_le[OF While.IH[OF inv `(strip c, s1) \ s2` bfilter_sound[OF `s1 <:up Inv`]] `post c \ Inv`]] `bval b s1` + show ?case by simp + qed + } note Inv = this + from While.prems(2) have "(WHILE b DO strip c, s) \ t" and "\ bval b t" + by(auto dest: While_final_False) + from Inv[OF this(1) up_fun_in_rep_le[OF `s <:up S` `S \ Inv`]] + have "t <:up Inv" . + from up_fun_in_rep_le[OF bfilter_sound[OF this] `bfilter b False Inv \ P`] + show ?case using `\ bval b t` by simp +qed + +lemma AI_sound: "(c,s) \ t \ t <:up post(AI c)" +by(fastforce simp: AI_def strip_pfp mono_def in_rep_Top_up + intro: step_sound pfp mono_step[OF le_refl]) + +end + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int1_ivl.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int1_ivl.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,276 @@ +(* Author: Tobias Nipkow *) + +theory Abs_Int1_ivl +imports Abs_Int1 +begin + +subsection "Interval Analysis" + +datatype ivl = I "int option" "int option" + +definition "rep_ivl i = (case i of + I (Some l) (Some h) \ {l..h} | + I (Some l) None \ {l..} | + I None (Some h) \ {..h} | + I None None \ UNIV)" + +definition "num_ivl n = I (Some n) (Some n)" + +instantiation option :: (plus)plus +begin + +fun plus_option where +"Some x + Some y = Some(x+y)" | +"_ + _ = None" + +instance proof qed + +end + +definition empty where "empty = I (Some 1) (Some 0)" + +fun is_empty where +"is_empty(I (Some l) (Some h)) = (h (case h of Some h \ h False) | None \ False)" +by(auto split:option.split) + +lemma [simp]: "is_empty i \ rep_ivl i = {}" +by(auto simp add: rep_ivl_def split: ivl.split option.split) + +definition "plus_ivl i1 i2 = (if is_empty i1 | is_empty i2 then empty else + case (i1,i2) of (I l1 h1, I l2 h2) \ I (l1+l2) (h1+h2))" + +instantiation ivl :: SL_top +begin + +definition le_option :: "bool \ int option \ int option \ bool" where +"le_option pos x y = + (case x of (Some i) \ (case y of Some j \ i\j | None \ pos) + | None \ (case y of Some j \ \pos | None \ True))" + +fun le_aux where +"le_aux (I l1 h1) (I l2 h2) = (le_option False l2 l1 & le_option True h1 h2)" + +definition le_ivl where +"i1 \ i2 = + (if is_empty i1 then True else + if is_empty i2 then False else le_aux i1 i2)" + +definition min_option :: "bool \ int option \ int option \ int option" where +"min_option pos o1 o2 = (if le_option pos o1 o2 then o1 else o2)" + +definition max_option :: "bool \ int option \ int option \ int option" where +"max_option pos o1 o2 = (if le_option pos o1 o2 then o2 else o1)" + +definition "i1 \ i2 = + (if is_empty i1 then i2 else if is_empty i2 then i1 + else case (i1,i2) of (I l1 h1, I l2 h2) \ + I (min_option False l1 l2) (max_option True h1 h2))" + +definition "\ = I None None" + +instance +proof + case goal1 thus ?case + by(cases x, simp add: le_ivl_def le_option_def split: option.split) +next + case goal2 thus ?case + by(cases x, cases y, cases z, auto simp: le_ivl_def le_option_def split: option.splits if_splits) +next + case goal3 thus ?case + by(cases x, cases y, simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits) +next + case goal4 thus ?case + by(cases x, cases y, simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits) +next + case goal5 thus ?case + by(cases x, cases y, cases z, auto simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits if_splits) +next + case goal6 thus ?case + by(cases x, simp add: Top_ivl_def le_ivl_def le_option_def split: option.split) +qed + +end + + +instantiation ivl :: L_top_bot +begin + +definition "i1 \ i2 = (if is_empty i1 \ is_empty i2 then empty else + case (i1,i2) of (I l1 h1, I l2 h2) \ + I (max_option False l1 l2) (min_option True h1 h2))" + +definition "\ = empty" + +instance +proof + case goal1 thus ?case + by (simp add:meet_ivl_def empty_def meet_ivl_def le_ivl_def le_option_def max_option_def min_option_def split: ivl.splits option.splits) +next + case goal2 thus ?case + by (simp add:meet_ivl_def empty_def meet_ivl_def le_ivl_def le_option_def max_option_def min_option_def split: ivl.splits option.splits) +next + case goal3 thus ?case + by (cases x, cases y, cases z, auto simp add: le_ivl_def meet_ivl_def empty_def le_option_def max_option_def min_option_def split: option.splits if_splits) +next + case goal4 show ?case by(cases x, simp add: bot_ivl_def empty_def le_ivl_def) +qed + +end + +instantiation option :: (minus)minus +begin + +fun minus_option where +"Some x - Some y = Some(x-y)" | +"_ - _ = None" + +instance proof qed + +end + +definition "minus_ivl i1 i2 = (if is_empty i1 | is_empty i2 then empty else + case (i1,i2) of (I l1 h1, I l2 h2) \ I (l1-h2) (h1-l2))" + +lemma rep_minus_ivl: + "n1 : rep_ivl i1 \ n2 : rep_ivl i2 \ n1-n2 : rep_ivl(minus_ivl i1 i2)" +by(auto simp add: minus_ivl_def rep_ivl_def split: ivl.splits option.splits) + + +definition "filter_plus_ivl i i1 i2 = ((*if is_empty i then empty else*) + i1 \ minus_ivl i i2, i2 \ minus_ivl i i1)" + +fun filter_less_ivl :: "bool \ ivl \ ivl \ ivl * ivl" where +"filter_less_ivl res (I l1 h1) (I l2 h2) = + (if is_empty(I l1 h1) \ is_empty(I l2 h2) then (empty, empty) else + if res + then (I l1 (min_option True h1 (h2 - Some 1)), + I (max_option False (l1 + Some 1) l2) h2) + else (I (max_option False l1 l2) h1, I l2 (min_option True h1 h2)))" + +interpretation Rep rep_ivl +proof + case goal1 thus ?case + by(auto simp: rep_ivl_def le_ivl_def le_option_def split: ivl.split option.split if_splits) +next + case goal2 show ?case by(simp add: rep_ivl_def Top_ivl_def) +qed + +interpretation Val_abs rep_ivl num_ivl plus_ivl +proof + case goal1 thus ?case by(simp add: rep_ivl_def num_ivl_def) +next + case goal2 thus ?case + by(auto simp add: rep_ivl_def plus_ivl_def split: ivl.split option.splits) +next + case goal3 thus ?case + by(auto simp: plus_ivl_def le_ivl_def le_option_def empty_def split: if_splits ivl.splits option.splits) +qed + +interpretation Rep1 rep_ivl +proof + case goal1 thus ?case + by(auto simp add: rep_ivl_def meet_ivl_def empty_def min_option_def max_option_def split: ivl.split option.split) +next + case goal2 show ?case by(auto simp add: bot_ivl_def rep_ivl_def empty_def) +qed + +lemma mono_minus_ivl: + "i1 \ i1' \ i2 \ i2' \ minus_ivl i1 i2 \ minus_ivl i1' i2'" +apply(auto simp add: minus_ivl_def empty_def le_ivl_def le_option_def split: ivl.splits) + apply(simp split: option.splits) + apply(simp split: option.splits) +apply(simp split: option.splits) +done + + +interpretation + Val_abs1 rep_ivl num_ivl plus_ivl filter_plus_ivl filter_less_ivl +proof + case goal1 thus ?case + by(auto simp add: filter_plus_ivl_def) + (metis rep_minus_ivl add_diff_cancel add_commute)+ +next + case goal2 thus ?case + by(cases a1, cases a2, + auto simp: rep_ivl_def min_option_def max_option_def le_option_def split: if_splits option.splits) +next + case goal3 thus ?case + by(auto simp: filter_plus_ivl_def le_prod_def mono_meet mono_minus_ivl) +next + case goal4 thus ?case + apply(cases a1, cases b1, cases a2, cases b2, auto simp: le_prod_def) + by(auto simp add: empty_def le_ivl_def le_option_def min_option_def max_option_def split: option.splits) +qed + +interpretation + Abs_Int1 rep_ivl num_ivl plus_ivl filter_plus_ivl filter_less_ivl "(iter 20)" +defines afilter_ivl is afilter +and bfilter_ivl is bfilter +and step_ivl is step +and AI_ivl is AI +and aval_ivl is aval' +proof qed (auto simp: iter_pfp strip_iter) + +definition "test1_ivl = + ''y'' ::= N 7; + IF Less (V ''x'') (V ''y'') + THEN ''y'' ::= Plus (V ''y'') (V ''x'') + ELSE ''x'' ::= Plus (V ''x'') (V ''y'')" + +translations +"{i..j}" <= "CONST I (CONST Some i) (CONST Some j)" +"{..j}" <= "CONST I (CONST None) (CONST Some j)" +"{i..}" <= "CONST I (CONST Some i) (CONST None)" +"CONST UNIV" <= "CONST I (CONST None) (CONST None)" + +value [code] "show_acom (AI_ivl test1_ivl)" + +value [code] "show_acom (AI_const test3_const)" +value [code] "show_acom (AI_ivl test3_const)" + +value [code] "show_acom (AI_const test4_const)" +value [code] "show_acom (AI_ivl test4_const)" + +value [code] "show_acom (AI_ivl test6_const)" + +definition "test2_ivl = + WHILE Less (V ''x'') (N 100) + DO ''x'' ::= Plus (V ''x'') (N 1)" + +value [code] "show_acom (AI_ivl test2_ivl)" + +definition "test3_ivl = + ''x'' ::= N 7; + WHILE Less (V ''x'') (N 100) + DO ''x'' ::= Plus (V ''x'') (N 1)" + +value [code] "show_acom (AI_ivl test3_ivl)" +value [code] "show_acom (((step_ivl \)^^0) (\\<^sub>c test3_ivl))" +value [code] "show_acom (((step_ivl \)^^1) (\\<^sub>c test3_ivl))" +value [code] "show_acom (((step_ivl \)^^2) (\\<^sub>c test3_ivl))" +value [code] "show_acom (((step_ivl \)^^3) (\\<^sub>c test3_ivl))" +value [code] "show_acom (((step_ivl \)^^4) (\\<^sub>c test3_ivl))" + +definition "test4_ivl = + ''x'' ::= N 0; ''y'' ::= N 100; ''z'' ::= Plus (V ''x'') (V ''y''); + WHILE Less (V ''x'') (N 11) + DO (''x'' ::= Plus (V ''x'') (N 1); ''y'' ::= Plus (V ''y'') (N -1))" +value [code] "show_acom(AI_ivl test4_ivl)" + +definition "test5_ivl = + ''x'' ::= N 0; ''y'' ::= N 0; + WHILE Less (V ''x'') (N 1001) + DO (''y'' ::= V ''x''; ''x'' ::= Plus (V ''x'') (N 1))" +value [code] "show_acom(AI_ivl test5_ivl)" + +text{* Nontermination not detected: *} +definition "test6_ivl = + ''x'' ::= N 0; + WHILE Less (V ''x'') (N 1) DO ''x'' ::= Plus (V ''x'') (N -1)" +value [code] "show_acom(AI_ivl test6_ivl)" + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int2.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int2.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,216 @@ +(* Author: Tobias Nipkow *) + +theory Abs_Int2 +imports Abs_Int1_ivl +begin + + +subsection "Widening and Narrowing" + +class WN = SL_top + +fixes widen :: "'a \ 'a \ 'a" (infix "\" 65) +assumes widen: "y \ x \ y" +fixes narrow :: "'a \ 'a \ 'a" (infix "\" 65) +assumes narrow1: "y \ x \ y \ x \ y" +assumes narrow2: "y \ x \ x \ y \ x" + + +instantiation ivl :: WN +begin + +definition "widen_ivl ivl1 ivl2 = + ((*if is_empty ivl1 then ivl2 else + if is_empty ivl2 then ivl1 else*) + case (ivl1,ivl2) of (I l1 h1, I l2 h2) \ + I (if le_option False l2 l1 \ l2 \ l1 then None else l1) + (if le_option True h1 h2 \ h1 \ h2 then None else h1))" + +definition "narrow_ivl ivl1 ivl2 = + ((*if is_empty ivl1 \ is_empty ivl2 then empty else*) + case (ivl1,ivl2) of (I l1 h1, I l2 h2) \ + I (if l1 = None then l2 else l1) + (if h1 = None then h2 else h1))" + +instance +proof qed + (auto simp add: widen_ivl_def narrow_ivl_def le_option_def le_ivl_def empty_def split: ivl.split option.split if_splits) + +end + +instantiation st :: (WN)WN +begin + +definition "widen_st F1 F2 = + FunDom (\x. fun F1 x \ fun F2 x) (inter_list (dom F1) (dom F2))" + +definition "narrow_st F1 F2 = + FunDom (\x. fun F1 x \ fun F2 x) (inter_list (dom F1) (dom F2))" + +instance +proof + case goal1 thus ?case + by(simp add: widen_st_def le_st_def lookup_def widen) +next + case goal2 thus ?case + by(auto simp: narrow_st_def le_st_def lookup_def narrow1) +next + case goal3 thus ?case + by(auto simp: narrow_st_def le_st_def lookup_def narrow2) +qed + +end + +instantiation up :: (WN)WN +begin + +fun widen_up where +"widen_up Bot x = x" | +"widen_up x Bot = x" | +"widen_up (Up x) (Up y) = Up(x \ y)" + +fun narrow_up where +"narrow_up Bot x = Bot" | +"narrow_up x Bot = Bot" | +"narrow_up (Up x) (Up y) = Up(x \ y)" + +instance +proof + case goal1 show ?case + by(induct x y rule: widen_up.induct) (simp_all add: widen) +next + case goal2 thus ?case + by(induct x y rule: narrow_up.induct) (simp_all add: narrow1) +next + case goal3 thus ?case + by(induct x y rule: narrow_up.induct) (simp_all add: narrow2) +qed + +end + +fun map2_acom :: "('a \ 'a \ 'a) \ 'a acom \ 'a acom \ 'a acom" where +"map2_acom f (SKIP {a1}) (SKIP {a2}) = (SKIP {f a1 a2})" | +"map2_acom f (x ::= e {a1}) (x' ::= e' {a2}) = (x ::= e {f a1 a2})" | +"map2_acom f (c1;c2) (c1';c2') = (map2_acom f c1 c1'; map2_acom f c2 c2')" | +"map2_acom f (IF b THEN c1 ELSE c2 {a1}) (IF b' THEN c1' ELSE c2' {a2}) = + (IF b THEN map2_acom f c1 c1' ELSE map2_acom f c2 c2' {f a1 a2})" | +"map2_acom f ({a1} WHILE b DO c {a2}) ({a3} WHILE b' DO c' {a4}) = + ({f a1 a3} WHILE b DO map2_acom f c c' {f a2 a4})" + +abbreviation widen_acom :: "('a::WN)acom \ 'a acom \ 'a acom" (infix "\\<^sub>c" 65) +where "widen_acom == map2_acom (op \)" + +abbreviation narrow_acom :: "('a::WN)acom \ 'a acom \ 'a acom" (infix "\\<^sub>c" 65) +where "narrow_acom == map2_acom (op \)" + +lemma narrow1_acom: "y \ x \ y \ x \\<^sub>c y" +by(induct y x rule: le_acom.induct) (simp_all add: narrow1) + +lemma narrow2_acom: "y \ x \ x \\<^sub>c y \ x" +by(induct y x rule: le_acom.induct) (simp_all add: narrow2) + +fun iter_up :: "(('a::WN)acom \ 'a acom) \ nat \ 'a acom \ 'a acom" where +"iter_up f 0 x = \\<^sub>c (strip x)" | +"iter_up f (Suc n) x = + (let fx = f x in if fx \ x then x else iter_up f n (x \\<^sub>c fx))" + +abbreviation + iter_down :: "(('a::WN)acom \ 'a acom) \ nat \ 'a acom \ 'a acom" where +"iter_down f n x == ((\x. x \\<^sub>c f x)^^n) x" + +definition + iter' :: "nat \ nat \ (('a::WN)acom \ 'a acom) \ 'a acom \ 'a acom" where +"iter' m n f x = iter_down f n (iter_up f m x)" + +lemma strip_map2_acom: + "strip c1 = strip c2 \ strip(map2_acom f c1 c2) = strip c1" +by(induct f c1 c2 rule: map2_acom.induct) simp_all + +lemma strip_iter_up: assumes "\c. strip(f c) = strip c" +shows "strip(iter_up f n c) = strip c" +apply (induction n arbitrary: c) + apply (metis iter_up.simps(1) strip_Top_acom snd_conv) +apply (simp add:Let_def) +by (metis assms strip_map2_acom) + +lemma iter_up_pfp: assumes "\c. strip(f c) = strip c" +shows "f(iter_up f n c) \ iter_up f n c" +apply (induction n arbitrary: c) + apply(simp add: assms) +apply (simp add:Let_def) +done + +lemma strip_iter_down: assumes "\c. strip(f c) = strip c" +shows "strip(iter_down f n c) = strip c" +apply (induction n arbitrary: c) + apply(simp) +apply (simp add: strip_map2_acom assms) +done + +lemma iter_down_pfp: assumes "mono f" and "f x0 \ x0" +defines "x n == iter_down f n x0" +shows "f(x n) \ x n" +proof (induction n) + case 0 show ?case by (simp add: x_def assms(2)) +next + case (Suc n) + have "f (x (Suc n)) = f(x n \\<^sub>c f(x n))" by(simp add: x_def) + also have "\ \ f(x n)" by(rule monoD[OF `mono f` narrow2_acom[OF Suc]]) + also have "\ \ x n \\<^sub>c f(x n)" by(rule narrow1_acom[OF Suc]) + also have "\ = x(Suc n)" by(simp add: x_def) + finally show ?case . +qed + +lemma iter_down_down: assumes "mono f" and "f x0 \ x0" +defines "x n == iter_down f n x0" +shows "x n \ x0" +proof (induction n) + case 0 show ?case by(simp add: x_def) +next + case (Suc n) + have "x(Suc n) = x n \\<^sub>c f(x n)" by(simp add: x_def) + also have "\ \ x n" unfolding x_def + by(rule narrow2_acom[OF iter_down_pfp[OF assms(1), OF assms(2)]]) + also have "\ \ x0" by(rule Suc) + finally show ?case . +qed + + +lemma iter'_pfp: assumes "\c. strip (f c) = strip c" and "mono f" +shows "f (iter' m n f c) \ iter' m n f c" +using iter_up_pfp[of f] iter_down_pfp[of f] +by(auto simp add: iter'_def Let_def assms) + +lemma strip_iter': assumes "\c. strip(f c) = strip c" +shows "strip(iter' m n f c) = strip c" +by(simp add: iter'_def strip_iter_down strip_iter_up assms) + + +interpretation + Abs_Int1 rep_ivl num_ivl plus_ivl filter_plus_ivl filter_less_ivl "(iter' 20 5)" +defines afilter_ivl' is afilter +and bfilter_ivl' is bfilter +and step_ivl' is step +and AI_ivl' is AI +and aval_ivl' is aval' +proof qed (auto simp: iter'_pfp strip_iter') + +value [code] "show_acom (AI_ivl test3_ivl)" +value [code] "show_acom (AI_ivl' test3_ivl)" + +definition "step_up n = ((\c. c \\<^sub>c step_ivl \ c)^^n)" +definition "step_down n = ((\c. c \\<^sub>c step_ivl \ c)^^n)" + +value [code] "show_acom (step_up 1 (\\<^sub>c test3_ivl))" +value [code] "show_acom (step_up 2 (\\<^sub>c test3_ivl))" +value [code] "show_acom (step_up 3 (\\<^sub>c test3_ivl))" +value [code] "show_acom (step_up 4 (\\<^sub>c test3_ivl))" +value [code] "show_acom (step_up 5 (\\<^sub>c test3_ivl))" +value [code] "show_acom (step_down 1 (step_up 5 (\\<^sub>c test3_ivl)))" +value [code] "show_acom (step_down 2 (step_up 5 (\\<^sub>c test3_ivl)))" +value [code] "show_acom (step_down 3 (step_up 5 (\\<^sub>c test3_ivl)))" + +value [code] "show_acom (AI_ivl' test4_ivl)" +value [code] "show_acom (AI_ivl' test5_ivl)" +value [code] "show_acom (AI_ivl' test6_ivl)" + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int0.thy --- a/src/HOL/IMP/Abs_Int_Den/Abs_Int0.thy Wed Sep 28 08:51:55 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,67 +0,0 @@ -(* Author: Tobias Nipkow *) - -theory Abs_Int0 -imports Abs_State -begin - -subsection "Computable Abstract Interpretation" - -text{* Abstract interpretation over type @{text astate} instead of -functions. *} - -locale Abs_Int = Val_abs + -fixes pfp :: "('a astate \ 'a astate) \ 'a astate \ 'a astate" -assumes pfp: "f(pfp f x0) \ pfp f x0" -assumes above: "x0 \ pfp f x0" -begin - -fun aval' :: "aexp \ 'a astate \ 'a" where -"aval' (N n) _ = num' n" | -"aval' (V x) S = lookup S x" | -"aval' (Plus e1 e2) S = plus' (aval' e1 S) (aval' e2 S)" - -abbreviation astate_in_rep (infix "<:" 50) where -"s <: S == ALL x. s x <: lookup S x" - -lemma astate_in_rep_le: "(s::state) <: S \ S \ T \ s <: T" -by (metis in_mono le_astate_def le_rep lookup_def top) - -lemma aval'_sound: "s <: S \ aval a s <: aval' a S" -by (induct a) (auto simp: rep_num' rep_plus') - - -fun AI :: "com \ 'a astate \ 'a astate" where -"AI SKIP S = S" | -"AI (x ::= a) S = update S x (aval' a S)" | -"AI (c1;c2) S = AI c2 (AI c1 S)" | -"AI (IF b THEN c1 ELSE c2) S = (AI c1 S) \ (AI c2 S)" | -"AI (WHILE b DO c) S = pfp (AI c) S" - -lemma AI_sound: "(c,s) \ t \ s <: S0 \ t <: AI c S0" -proof(induction c arbitrary: s t S0) - case SKIP thus ?case by fastforce -next - case Assign thus ?case - by (auto simp: lookup_update aval'_sound) -next - case Semi thus ?case by auto -next - case If thus ?case - by (metis AI.simps(4) IfE astate_in_rep_le join_ge1 join_ge2) -next - case (While b c) - let ?P = "pfp (AI c) S0" - { fix s t have "(WHILE b DO c,s) \ t \ s <: ?P \ t <: ?P" - proof(induction "WHILE b DO c" s t rule: big_step_induct) - case WhileFalse thus ?case by simp - next - case WhileTrue thus ?case using While.IH pfp astate_in_rep_le by metis - qed - } - with astate_in_rep_le[OF `s <: S0` above] - show ?case by (metis While(2) AI.simps(5)) -qed - -end - -end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int0_const.thy --- a/src/HOL/IMP/Abs_Int_Den/Abs_Int0_const.thy Wed Sep 28 08:51:55 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,111 +0,0 @@ -(* Author: Tobias Nipkow *) - -theory Abs_Int0_const -imports Abs_Int0 -begin - -subsection "Constant Propagation" - -datatype cval = Const val | Any - -fun rep_cval where -"rep_cval (Const n) = {n}" | -"rep_cval (Any) = UNIV" - -fun plus_cval where -"plus_cval (Const m) (Const n) = Const(m+n)" | -"plus_cval _ _ = Any" - -instantiation cval :: SL_top -begin - -fun le_cval where -"_ \ Any = True" | -"Const n \ Const m = (n=m)" | -"Any \ Const _ = False" - -fun join_cval where -"Const m \ Const n = (if n=m then Const m else Any)" | -"_ \ _ = Any" - -definition "Top = Any" - -instance -proof - case goal1 thus ?case by (cases x) simp_all -next - case goal2 thus ?case by(cases z, cases y, cases x, simp_all) -next - case goal3 thus ?case by(cases x, cases y, simp_all) -next - case goal4 thus ?case by(cases y, cases x, simp_all) -next - case goal5 thus ?case by(cases z, cases y, cases x, simp_all) -next - case goal6 thus ?case by(simp add: Top_cval_def) -qed - -end - -interpretation Rep rep_cval -proof - case goal1 thus ?case - by(cases a, cases b, simp, simp, cases b, simp, simp) -qed - -interpretation Val_abs rep_cval Const plus_cval -proof - case goal1 show ?case by simp -next - case goal2 thus ?case - by(cases a1, cases a2, simp, simp, cases a2, simp, simp) -qed - -interpretation Abs_Int rep_cval Const plus_cval "(iter' 3)" -defines AI_const is AI -and aval'_const is aval' -proof qed (auto simp: iter'_pfp_above) - -text{* Straight line code: *} -definition "test1_const = - ''y'' ::= N 7; - ''z'' ::= Plus (V ''y'') (N 2); - ''y'' ::= Plus (V ''x'') (N 0)" - -text{* Conditional: *} -definition "test2_const = - IF Less (N 41) (V ''x'') THEN ''x'' ::= N 5 ELSE ''x'' ::= N 5" - -text{* Conditional, test is ignored: *} -definition "test3_const = - ''x'' ::= N 42; - IF Less (N 41) (V ''x'') THEN ''x'' ::= N 5 ELSE ''x'' ::= N 6" - -text{* While: *} -definition "test4_const = - ''x'' ::= N 0; WHILE B True DO ''x'' ::= N 0" - -text{* While, test is ignored: *} -definition "test5_const = - ''x'' ::= N 0; WHILE Less (V ''x'') (N 1) DO ''x'' ::= N 1" - -text{* Iteration is needed: *} -definition "test6_const = - ''x'' ::= N 0; ''y'' ::= N 0; ''z'' ::= N 2; - WHILE Less (V ''x'') (N 1) DO (''x'' ::= V ''y''; ''y'' ::= V ''z'')" - -text{* More iteration would be needed: *} -definition "test7_const = - ''x'' ::= N 0; ''y'' ::= N 0; ''z'' ::= N 0; ''u'' ::= N 3; - WHILE Less (V ''x'') (N 1) - DO (''x'' ::= V ''y''; ''y'' ::= V ''z''; ''z'' ::= V ''u'')" - -value [code] "list (AI_const test1_const Top)" -value [code] "list (AI_const test2_const Top)" -value [code] "list (AI_const test3_const Top)" -value [code] "list (AI_const test4_const Top)" -value [code] "list (AI_const test5_const Top)" -value [code] "list (AI_const test6_const Top)" -value [code] "list (AI_const test7_const Top)" - -end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int0_fun.thy --- a/src/HOL/IMP/Abs_Int_Den/Abs_Int0_fun.thy Wed Sep 28 08:51:55 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,187 +0,0 @@ -(* Author: Tobias Nipkow *) - -header "Denotational Abstract Interpretation" - -theory Abs_Int0_fun -imports "~~/src/HOL/ex/Interpretation_with_Defs" Big_Step -begin - -subsection "Orderings" - -class preord = -fixes le :: "'a \ 'a \ bool" (infix "\" 50) -assumes le_refl[simp]: "x \ x" -and le_trans: "x \ y \ y \ z \ x \ z" - -text{* Note: no antisymmetry. Allows implementations where some abstract -element is implemented by two different values @{prop "x \ y"} -such that @{prop"x \ y"} and @{prop"y \ x"}. Antisymmetry is not -needed because we never compare elements for equality but only for @{text"\"}. -*} - -class SL_top = preord + -fixes join :: "'a \ 'a \ 'a" (infixl "\" 65) -fixes Top :: "'a" -assumes join_ge1 [simp]: "x \ x \ y" -and join_ge2 [simp]: "y \ x \ y" -and join_least: "x \ z \ y \ z \ x \ y \ z" -and top[simp]: "x \ Top" -begin - -lemma join_le_iff[simp]: "x \ y \ z \ x \ z \ y \ z" -by (metis join_ge1 join_ge2 join_least le_trans) - -fun iter :: "nat \ ('a \ 'a) \ 'a \ 'a" where -"iter 0 f _ = Top" | -"iter (Suc n) f x = (if f x \ x then x else iter n f (f x))" - -lemma iter_pfp: "f(iter n f x) \ iter n f x" -apply (induction n arbitrary: x) - apply (simp) -apply (simp) -done - -abbreviation iter' :: "nat \ ('a \ 'a) \ 'a \ 'a" where -"iter' n f x0 == iter n (\x. x0 \ f x) x0" - -lemma iter'_pfp_above: - "f(iter' n f x0) \ iter' n f x0" "x0 \ iter' n f x0" -using iter_pfp[of "\x. x0 \ f x"] by auto - -text{* So much for soundness. But how good an approximation of the post-fixed -point does @{const iter} yield? *} - -lemma iter_funpow: "iter n f x \ Top \ \k. iter n f x = (f^^k) x" -apply(induction n arbitrary: x) - apply simp -apply (auto) - apply(metis funpow.simps(1) id_def) -by (metis funpow.simps(2) funpow_swap1 o_apply) - -text{* For monotone @{text f}, @{term "iter f n x0"} yields the least -post-fixed point above @{text x0}, unless it yields @{text Top}. *} - -lemma iter_least_pfp: -assumes mono: "\x y. x \ y \ f x \ f y" and "iter n f x0 \ Top" -and "f p \ p" and "x0 \ p" shows "iter n f x0 \ p" -proof- - obtain k where "iter n f x0 = (f^^k) x0" - using iter_funpow[OF `iter n f x0 \ Top`] by blast - moreover - { fix n have "(f^^n) x0 \ p" - proof(induction n) - case 0 show ?case by(simp add: `x0 \ p`) - next - case (Suc n) thus ?case - by (simp add: `x0 \ p`)(metis Suc assms(3) le_trans mono) - qed - } ultimately show ?thesis by simp -qed - -end - -text{* The interface of abstract values: *} - -locale Rep = -fixes rep :: "'a::SL_top \ 'b set" -assumes le_rep: "a \ b \ rep a \ rep b" -begin - -abbreviation in_rep (infix "<:" 50) where "x <: a == x : rep a" - -lemma in_rep_join: "x <: a1 \ x <: a2 \ x <: a1 \ a2" -by (metis SL_top_class.join_ge1 SL_top_class.join_ge2 le_rep subsetD) - -end - -locale Val_abs = Rep rep - for rep :: "'a::SL_top \ val set" + -fixes num' :: "val \ 'a" -and plus' :: "'a \ 'a \ 'a" -assumes rep_num': "rep(num' n) = {n}" -and rep_plus': "n1 <: a1 \ n2 <: a2 \ n1+n2 <: plus' a1 a2" - - -instantiation "fun" :: (type, SL_top) SL_top -begin - -definition "f \ g = (ALL x. f x \ g x)" -definition "f \ g = (\x. f x \ g x)" -definition "Top = (\x. Top)" - -lemma join_apply[simp]: - "(f \ g) x = f x \ g x" -by (simp add: join_fun_def) - -instance -proof - case goal2 thus ?case by (metis le_fun_def preord_class.le_trans) -qed (simp_all add: le_fun_def Top_fun_def) - -end - -subsection "Abstract Interpretation Abstractly" - -text{* Abstract interpretation over abstract values. Abstract states are -simply functions. The post-fixed point finder is parameterized over. *} - -type_synonym 'a st = "name \ 'a" - -locale Abs_Int_Fun = Val_abs + -fixes pfp :: "('a st \ 'a st) \ 'a st \ 'a st" -assumes pfp: "f(pfp f x) \ pfp f x" -assumes above: "x \ pfp f x" -begin - -fun aval' :: "aexp \ (name \ 'a) \ 'a" where -"aval' (N n) _ = num' n" | -"aval' (V x) S = S x" | -"aval' (Plus a1 a2) S = plus' (aval' a1 S) (aval' a2 S)" - -abbreviation fun_in_rep (infix "<:" 50) where -"f <: F == \x. f x <: F x" - -lemma fun_in_rep_le: "(s::state) <: S \ S \ T \ s <: T" -by (metis le_fun_def le_rep subsetD) - -lemma aval'_sound: "s <: S \ aval a s <: aval' a S" -by (induct a) (auto simp: rep_num' rep_plus') - -fun AI :: "com \ (name \ 'a) \ (name \ 'a)" where -"AI SKIP S = S" | -"AI (x ::= a) S = S(x := aval' a S)" | -"AI (c1;c2) S = AI c2 (AI c1 S)" | -"AI (IF b THEN c1 ELSE c2) S = (AI c1 S) \ (AI c2 S)" | -"AI (WHILE b DO c) S = pfp (AI c) S" - -lemma AI_sound: "(c,s) \ t \ s <: S0 \ t <: AI c S0" -proof(induction c arbitrary: s t S0) - case SKIP thus ?case by fastforce -next - case Assign thus ?case by (auto simp: aval'_sound) -next - case Semi thus ?case by auto -next - case If thus ?case by(auto simp: in_rep_join) -next - case (While b c) - let ?P = "pfp (AI c) S0" - { fix s t have "(WHILE b DO c,s) \ t \ s <: ?P \ t <: ?P" - proof(induction "WHILE b DO c" s t rule: big_step_induct) - case WhileFalse thus ?case by simp - next - case WhileTrue thus ?case by(metis While.IH pfp fun_in_rep_le) - qed - } - with fun_in_rep_le[OF `s <: S0` above] - show ?case by (metis While(2) AI.simps(5)) -qed - -end - - -text{* Problem: not executable because of the comparison of abstract states, -i.e. functions, in the post-fixedpoint computation. Need to implement -abstract states concretely. *} - -end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int1.thy --- a/src/HOL/IMP/Abs_Int_Den/Abs_Int1.thy Wed Sep 28 08:51:55 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,214 +0,0 @@ -(* Author: Tobias Nipkow *) - -theory Abs_Int1 -imports Abs_Int0_const -begin - -subsection "Backward Analysis of Expressions" - -class L_top_bot = SL_top + -fixes meet :: "'a \ 'a \ 'a" (infixl "\" 65) -and Bot :: "'a" -assumes meet_le1 [simp]: "x \ y \ x" -and meet_le2 [simp]: "x \ y \ y" -and meet_greatest: "x \ y \ x \ z \ x \ y \ z" -assumes bot[simp]: "Bot \ x" - -locale Rep1 = Rep rep for rep :: "'a::L_top_bot \ 'b set" + -assumes inter_rep_subset_rep_meet: "rep a1 \ rep a2 \ rep(a1 \ a2)" -and rep_Bot: "rep Bot = {}" -begin - -lemma in_rep_meet: "x <: a1 \ x <: a2 \ x <: a1 \ a2" -by (metis IntI inter_rep_subset_rep_meet set_mp) - -lemma rep_meet[simp]: "rep(a1 \ a2) = rep a1 \ rep a2" -by (metis equalityI inter_rep_subset_rep_meet le_inf_iff le_rep meet_le1 meet_le2) - -end - - -locale Val_abs1 = Val_abs rep num' plus' + Rep1 rep - for rep :: "'a::L_top_bot \ int set" and num' plus' + -fixes filter_plus' :: "'a \ 'a \ 'a \ 'a * 'a" -and filter_less' :: "bool \ 'a \ 'a \ 'a * 'a" -assumes filter_plus': "filter_plus' a a1 a2 = (a1',a2') \ - n1 <: a1 \ n2 <: a2 \ n1+n2 <: a \ n1 <: a1' \ n2 <: a2'" -and filter_less': "filter_less' (n1 - n1 <: a1 \ n2 <: a2 \ n1 <: a1' \ n2 <: a2'" - -datatype 'a up = bot | Up 'a - -instantiation up :: (SL_top)SL_top -begin - -fun le_up where -"Up x \ Up y = (x \ y)" | -"bot \ y = True" | -"Up _ \ bot = False" - -lemma [simp]: "(x \ bot) = (x = bot)" -by (cases x) simp_all - -lemma [simp]: "(Up x \ u) = (EX y. u = Up y & x \ y)" -by (cases u) auto - -fun join_up where -"Up x \ Up y = Up(x \ y)" | -"bot \ y = y" | -"x \ bot = x" - -lemma [simp]: "x \ bot = x" -by (cases x) simp_all - - -definition "Top = Up Top" - -instance proof - case goal1 show ?case by(cases x, simp_all) -next - case goal2 thus ?case - by(cases z, simp, cases y, simp, cases x, auto intro: le_trans) -next - case goal3 thus ?case by(cases x, simp, cases y, simp_all) -next - case goal4 thus ?case by(cases y, simp, cases x, simp_all) -next - case goal5 thus ?case by(cases z, simp, cases y, simp, cases x, simp_all) -next - case goal6 thus ?case by(cases x, simp_all add: Top_up_def) -qed - -end - - -locale Abs_Int1 = Val_abs1 + -fixes pfp :: "('a astate up \ 'a astate up) \ 'a astate up \ 'a astate up" -assumes pfp: "f(pfp f x0) \ pfp f x0" -assumes above: "x0 \ pfp f x0" -begin - -(* FIXME avoid duplicating this defn *) -abbreviation astate_in_rep (infix "<:" 50) where -"s <: S == ALL x. s x <: lookup S x" - -abbreviation in_rep_up :: "state \ 'a astate up \ bool" (infix "<::" 50) where -"s <:: S == EX S0. S = Up S0 \ s <: S0" - -lemma in_rep_up_trans: "(s::state) <:: S \ S \ T \ s <:: T" -apply auto -by (metis in_mono le_astate_def le_rep lookup_def top) - -lemma in_rep_join_UpI: "s <:: S1 | s <:: S2 \ s <:: S1 \ S2" -by (metis in_rep_up_trans SL_top_class.join_ge1 SL_top_class.join_ge2) - -fun aval' :: "aexp \ 'a astate up \ 'a" ("aval\<^isup>#") where -"aval' _ bot = Bot" | -"aval' (N n) _ = num' n" | -"aval' (V x) (Up S) = lookup S x" | -"aval' (Plus a1 a2) S = plus' (aval' a1 S) (aval' a2 S)" - -lemma aval'_sound: "s <:: S \ aval a s <: aval' a S" -by (induct a) (auto simp: rep_num' rep_plus') - -fun afilter :: "aexp \ 'a \ 'a astate up \ 'a astate up" where -"afilter (N n) a S = (if n <: a then S else bot)" | -"afilter (V x) a S = (case S of bot \ bot | Up S \ - let a' = lookup S x \ a in - if a' \ Bot then bot else Up(update S x a'))" | -"afilter (Plus e1 e2) a S = - (let (a1,a2) = filter_plus' a (aval' e1 S) (aval' e2 S) - in afilter e1 a1 (afilter e2 a2 S))" - -text{* The test for @{const Bot} in the @{const V}-case is important: @{const -Bot} indicates that a variable has no possible values, i.e.\ that the current -program point is unreachable. But then the abstract state should collapse to -@{const bot}. Put differently, we maintain the invariant that in an abstract -state all variables are mapped to non-@{const Bot} values. Otherwise the -(pointwise) join of two abstract states, one of which contains @{const Bot} -values, may produce too large a result, thus making the analysis less -precise. *} - - -fun bfilter :: "bexp \ bool \ 'a astate up \ 'a astate up" where -"bfilter (B bv) res S = (if bv=res then S else bot)" | -"bfilter (Not b) res S = bfilter b (\ res) S" | -"bfilter (And b1 b2) res S = - (if res then bfilter b1 True (bfilter b2 True S) - else bfilter b1 False S \ bfilter b2 False S)" | -"bfilter (Less e1 e2) res S = - (let (res1,res2) = filter_less' res (aval' e1 S) (aval' e2 S) - in afilter e1 res1 (afilter e2 res2 S))" - -lemma afilter_sound: "s <:: S \ aval e s <: a \ s <:: afilter e a S" -proof(induction e arbitrary: a S) - case N thus ?case by simp -next - case (V x) - obtain S' where "S = Up S'" and "s <: S'" using `s <:: S` by auto - moreover hence "s x <: lookup S' x" by(simp) - moreover have "s x <: a" using V by simp - ultimately show ?case using V(1) - by(simp add: lookup_update Let_def) - (metis le_rep emptyE in_rep_meet rep_Bot subset_empty) -next - case (Plus e1 e2) thus ?case - using filter_plus'[OF _ aval'_sound[OF Plus(3)] aval'_sound[OF Plus(3)]] - by (auto split: prod.split) -qed - -lemma bfilter_sound: "s <:: S \ bv = bval b s \ s <:: bfilter b bv S" -proof(induction b arbitrary: S bv) - case B thus ?case by simp -next - case (Not b) thus ?case by simp -next - case (And b1 b2) thus ?case by (auto simp: in_rep_join_UpI) -next - case (Less e1 e2) thus ?case - by (auto split: prod.split) - (metis afilter_sound filter_less' aval'_sound Less) -qed - -fun AI :: "com \ 'a astate up \ 'a astate up" where -"AI SKIP S = S" | -"AI (x ::= a) S = - (case S of bot \ bot | Up S \ Up(update S x (aval' a (Up S))))" | -"AI (c1;c2) S = AI c2 (AI c1 S)" | -"AI (IF b THEN c1 ELSE c2) S = - AI c1 (bfilter b True S) \ AI c2 (bfilter b False S)" | -"AI (WHILE b DO c) S = - bfilter b False (pfp (\S. AI c (bfilter b True S)) S)" - -lemma AI_sound: "(c,s) \ t \ s <:: S \ t <:: AI c S" -proof(induction c arbitrary: s t S) - case SKIP thus ?case by fastforce -next - case Assign thus ?case - by (auto simp: lookup_update aval'_sound) -next - case Semi thus ?case by fastforce -next - case If thus ?case by (auto simp: in_rep_join_UpI bfilter_sound) -next - case (While b c) - let ?P = "pfp (\S. AI c (bfilter b True S)) S" - { fix s t - have "(WHILE b DO c,s) \ t \ s <:: ?P \ - t <:: bfilter b False ?P" - proof(induction "WHILE b DO c" s t rule: big_step_induct) - case WhileFalse thus ?case by(metis bfilter_sound) - next - case WhileTrue show ?case - by(rule WhileTrue, rule in_rep_up_trans[OF _ pfp], - rule While.IH[OF WhileTrue(2)], - rule bfilter_sound[OF WhileTrue.prems], simp add: WhileTrue(1)) - qed - } - with in_rep_up_trans[OF `s <:: S` above] While(2,3) AI.simps(5) - show ?case by simp -qed - -end - -end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int1_ivl.thy --- a/src/HOL/IMP/Abs_Int_Den/Abs_Int1_ivl.thy Wed Sep 28 08:51:55 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,260 +0,0 @@ -(* Author: Tobias Nipkow *) - -theory Abs_Int1_ivl -imports Abs_Int1 -begin - -subsection "Interval Analysis" - -datatype ivl = I "int option" "int option" - -text{* We assume an important invariant: arithmetic operations are never -applied to empty intervals @{term"I (Some i) (Some j)"} with @{term"j < -i"}. This avoids special cases. Why can we assume this? Because an empty -interval of values for a variable means that the current program point is -unreachable. But this should actually translate into the bottom state, not a -state where some variables have empty intervals. *} - -definition "rep_ivl i = - (case i of I (Some l) (Some h) \ {l..h} | I (Some l) None \ {l..} - | I None (Some h) \ {..h} | I None None \ UNIV)" - -definition "num_ivl n = I (Some n) (Some n)" - -instantiation option :: (plus)plus -begin - -fun plus_option where -"Some x + Some y = Some(x+y)" | -"_ + _ = None" - -instance proof qed - -end - -definition empty where "empty = I (Some 1) (Some 0)" - -fun is_empty where -"is_empty(I (Some l) (Some h)) = (h (case h of Some h \ h False) | None \ False)" -by(auto split:option.split) - -lemma [simp]: "is_empty i \ rep_ivl i = {}" -by(auto simp add: rep_ivl_def split: ivl.split option.split) - -definition "plus_ivl i1 i2 = ((*if is_empty i1 | is_empty i2 then empty else*) - case (i1,i2) of (I l1 h1, I l2 h2) \ I (l1+l2) (h1+h2))" - -instantiation ivl :: SL_top -begin - -definition le_option :: "bool \ int option \ int option \ bool" where -"le_option pos x y = - (case x of (Some i) \ (case y of Some j \ i\j | None \ pos) - | None \ (case y of Some j \ \pos | None \ True))" - -fun le_aux where -"le_aux (I l1 h1) (I l2 h2) = (le_option False l2 l1 & le_option True h1 h2)" - -definition le_ivl where -"i1 \ i2 = - (if is_empty i1 then True else - if is_empty i2 then False else le_aux i1 i2)" - -definition min_option :: "bool \ int option \ int option \ int option" where -"min_option pos o1 o2 = (if le_option pos o1 o2 then o1 else o2)" - -definition max_option :: "bool \ int option \ int option \ int option" where -"max_option pos o1 o2 = (if le_option pos o1 o2 then o2 else o1)" - -definition "i1 \ i2 = - (if is_empty i1 then i2 else if is_empty i2 then i1 - else case (i1,i2) of (I l1 h1, I l2 h2) \ - I (min_option False l1 l2) (max_option True h1 h2))" - -definition "Top = I None None" - -instance -proof - case goal1 thus ?case - by(cases x, simp add: le_ivl_def le_option_def split: option.split) -next - case goal2 thus ?case - by(cases x, cases y, cases z, auto simp: le_ivl_def le_option_def split: option.splits if_splits) -next - case goal3 thus ?case - by(cases x, cases y, simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits) -next - case goal4 thus ?case - by(cases x, cases y, simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits) -next - case goal5 thus ?case - by(cases x, cases y, cases z, auto simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits if_splits) -next - case goal6 thus ?case - by(cases x, simp add: Top_ivl_def le_ivl_def le_option_def split: option.split) -qed - -end - - -instantiation ivl :: L_top_bot -begin - -definition "i1 \ i2 = (if is_empty i1 \ is_empty i2 then empty else - case (i1,i2) of (I l1 h1, I l2 h2) \ - I (max_option False l1 l2) (min_option True h1 h2))" - -definition "Bot = empty" - -instance -proof - case goal1 thus ?case - by (simp add:meet_ivl_def empty_def meet_ivl_def le_ivl_def le_option_def max_option_def min_option_def split: ivl.splits option.splits) -next - case goal2 thus ?case - by (simp add:meet_ivl_def empty_def meet_ivl_def le_ivl_def le_option_def max_option_def min_option_def split: ivl.splits option.splits) -next - case goal3 thus ?case - by (cases x, cases y, cases z, auto simp add: le_ivl_def meet_ivl_def empty_def le_option_def max_option_def min_option_def split: option.splits if_splits) -next - case goal4 show ?case by(cases x, simp add: Bot_ivl_def empty_def le_ivl_def) -qed - -end - -instantiation option :: (minus)minus -begin - -fun minus_option where -"Some x - Some y = Some(x-y)" | -"_ - _ = None" - -instance proof qed - -end - -definition "minus_ivl i1 i2 = ((*if is_empty i1 | is_empty i2 then empty else*) - case (i1,i2) of (I l1 h1, I l2 h2) \ I (l1-h2) (h1-l2))" - -lemma rep_minus_ivl: - "n1 : rep_ivl i1 \ n2 : rep_ivl i2 \ n1-n2 : rep_ivl(minus_ivl i1 i2)" -by(auto simp add: minus_ivl_def rep_ivl_def split: ivl.splits option.splits) - - -definition "filter_plus_ivl i i1 i2 = ((*if is_empty i then empty else*) - i1 \ minus_ivl i i2, i2 \ minus_ivl i i1)" - -fun filter_less_ivl :: "bool \ ivl \ ivl \ ivl * ivl" where -"filter_less_ivl res (I l1 h1) (I l2 h2) = - ((*if is_empty(I l1 h1) \ is_empty(I l2 h2) then (empty, empty) else*) - if res - then (I l1 (min_option True h1 (h2 - Some 1)), - I (max_option False (l1 + Some 1) l2) h2) - else (I (max_option False l1 l2) h1, I l2 (min_option True h1 h2)))" - -interpretation Rep rep_ivl -proof - case goal1 thus ?case - by(auto simp: rep_ivl_def le_ivl_def le_option_def split: ivl.split option.split if_splits) -qed - -interpretation Val_abs rep_ivl num_ivl plus_ivl -proof - case goal1 thus ?case by(simp add: rep_ivl_def num_ivl_def) -next - case goal2 thus ?case - by(auto simp add: rep_ivl_def plus_ivl_def split: ivl.split option.splits) -qed - -interpretation Rep1 rep_ivl -proof - case goal1 thus ?case - by(auto simp add: rep_ivl_def meet_ivl_def empty_def min_option_def max_option_def split: ivl.split option.split) -next - case goal2 show ?case by(auto simp add: Bot_ivl_def rep_ivl_def empty_def) -qed - -interpretation - Val_abs1 rep_ivl num_ivl plus_ivl filter_plus_ivl filter_less_ivl -proof - case goal1 thus ?case - by(auto simp add: filter_plus_ivl_def) - (metis rep_minus_ivl add_diff_cancel add_commute)+ -next - case goal2 thus ?case - by(cases a1, cases a2, - auto simp: rep_ivl_def min_option_def max_option_def le_option_def split: if_splits option.splits) -qed - -interpretation - Abs_Int1 rep_ivl num_ivl plus_ivl filter_plus_ivl filter_less_ivl "(iter' 3)" -defines afilter_ivl is afilter -and bfilter_ivl is bfilter -and AI_ivl is AI -and aval_ivl is aval' -proof qed (auto simp: iter'_pfp_above) - - -fun list_up where -"list_up bot = bot" | -"list_up (Up x) = Up(list x)" - -value [code] "list_up(afilter_ivl (N 5) (I (Some 4) (Some 5)) Top)" -value [code] "list_up(afilter_ivl (N 5) (I (Some 4) (Some 4)) Top)" -value [code] "list_up(afilter_ivl (V ''x'') (I (Some 4) (Some 4)) - (Up(FunDom(Top(''x'':=I (Some 5) (Some 6))) [''x''])))" -value [code] "list_up(afilter_ivl (V ''x'') (I (Some 4) (Some 5)) - (Up(FunDom(Top(''x'':=I (Some 5) (Some 6))) [''x''])))" -value [code] "list_up(afilter_ivl (Plus (V ''x'') (V ''x'')) (I (Some 0) (Some 10)) - (Up(FunDom(Top(''x'':= I (Some 0) (Some 100)))[''x''])))" -value [code] "list_up(afilter_ivl (Plus (V ''x'') (N 7)) (I (Some 0) (Some 10)) - (Up(FunDom(Top(''x'':= I (Some 0) (Some 100)))[''x''])))" - -value [code] "list_up(bfilter_ivl (Less (V ''x'') (V ''x'')) True - (Up(FunDom(Top(''x'':= I (Some 0) (Some 0)))[''x''])))" -value [code] "list_up(bfilter_ivl (Less (V ''x'') (V ''x'')) True - (Up(FunDom(Top(''x'':= I (Some 0) (Some 2)))[''x''])))" -value [code] "list_up(bfilter_ivl (Less (V ''x'') (Plus (N 10) (V ''y''))) True - (Up(FunDom(Top(''x'':= I (Some 15) (Some 20),''y'':= I (Some 5) (Some 7)))[''x'', ''y''])))" - -definition "test_ivl1 = - ''y'' ::= N 7; - IF Less (V ''x'') (V ''y'') - THEN ''y'' ::= Plus (V ''y'') (V ''x'') - ELSE ''x'' ::= Plus (V ''x'') (V ''y'')" -value [code] "list_up(AI_ivl test_ivl1 Top)" - -value "list_up (AI_ivl test3_const Top)" - -value "list_up (AI_ivl test5_const Top)" - -value "list_up (AI_ivl test6_const Top)" - -definition "test2_ivl = - ''y'' ::= N 7; - WHILE Less (V ''x'') (N 100) DO ''y'' ::= Plus (V ''y'') (N 1)" -value [code] "list_up(AI_ivl test2_ivl Top)" - -definition "test3_ivl = - ''x'' ::= N 0; ''y'' ::= N 100; ''z'' ::= Plus (V ''x'') (V ''y''); - WHILE Less (V ''x'') (N 11) - DO (''x'' ::= Plus (V ''x'') (N 1); ''y'' ::= Plus (V ''y'') (N -1))" -value [code] "list_up(AI_ivl test3_ivl Top)" - -definition "test4_ivl = - ''x'' ::= N 0; ''y'' ::= N 0; - WHILE Less (V ''x'') (N 1001) - DO (''y'' ::= V ''x''; ''x'' ::= Plus (V ''x'') (N 1))" -value [code] "list_up(AI_ivl test4_ivl Top)" - -text{* Nontermination not detected: *} -definition "test5_ivl = - ''x'' ::= N 0; - WHILE Less (V ''x'') (N 1) DO ''x'' ::= Plus (V ''x'') (N -1)" -value [code] "list_up(AI_ivl test5_ivl Top)" - -end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int2.thy --- a/src/HOL/IMP/Abs_Int_Den/Abs_Int2.thy Wed Sep 28 08:51:55 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,207 +0,0 @@ -(* Author: Tobias Nipkow *) - -theory Abs_Int2 -imports Abs_Int1_ivl -begin - -context preord -begin - -definition mono where "mono f = (\x y. x \ y \ f x \ f y)" - -lemma monoD: "mono f \ x \ y \ f x \ f y" by(simp add: mono_def) - -lemma mono_comp: "mono f \ mono g \ mono (g o f)" -by(simp add: mono_def) - -declare le_trans[trans] - -end - - -subsection "Widening and Narrowing" - -text{* Jumping to the trivial post-fixed point @{const Top} in case @{text k} -rounds of iteration did not reach a post-fixed point (as in @{const iter}) is -a trivial widening step. We generalise this idea and complement it with -narrowing, a process to regain precision. - -Class @{text WN} makes some assumptions about the widening and narrowing -operators. The assumptions serve two purposes. Together with a further -assumption that certain chains become stationary, they permit to prove -termination of the fixed point iteration, which we do not --- we limit the -number of iterations as before. The second purpose of the narrowing -assumptions is to prove that the narrowing iteration keeps on producing -post-fixed points and that it goes down. However, this requires the function -being iterated to be monotone. Unfortunately, abstract interpretation with -widening is not monotone. Hence the (recursive) abstract interpretation of a -loop body that again contains a loop may result in a non-monotone -function. Therefore our narrowing iteration needs to check at every step -that a post-fixed point is maintained, and we cannot prove that the precision -increases. *} - -class WN = SL_top + -fixes widen :: "'a \ 'a \ 'a" (infix "\" 65) -assumes widen: "y \ x \ y" -fixes narrow :: "'a \ 'a \ 'a" (infix "\" 65) -assumes narrow1: "y \ x \ y \ x \ y" -assumes narrow2: "y \ x \ x \ y \ x" -begin - -fun iter_up :: "('a \ 'a) \ nat \ 'a \ 'a" where -"iter_up f 0 x = Top" | -"iter_up f (Suc n) x = - (let fx = f x in if fx \ x then x else iter_up f n (x \ fx))" - -lemma iter_up_pfp: "f(iter_up f n x) \ iter_up f n x" -apply (induction n arbitrary: x) - apply (simp) -apply (simp add: Let_def) -done - -fun iter_down :: "('a \ 'a) \ nat \ 'a \ 'a" where -"iter_down f 0 x = x" | -"iter_down f (Suc n) x = - (let y = x \ f x in if f y \ y then iter_down f n y else x)" - -lemma iter_down_pfp: "f x \ x \ f(iter_down f n x) \ iter_down f n x" -apply (induction n arbitrary: x) - apply (simp) -apply (simp add: Let_def) -done - -definition iter' :: "nat \ nat \ ('a \ 'a) \ 'a \ 'a" where -"iter' m n f x = - (let f' = (\y. x \ f y) in iter_down f' n (iter_up f' m x))" - -lemma iter'_pfp_above: -shows "f(iter' m n f x0) \ iter' m n f x0" -and "x0 \ iter' m n f x0" -using iter_up_pfp[of "\x. x0 \ f x"] iter_down_pfp[of "\x. x0 \ f x"] -by(auto simp add: iter'_def Let_def) - -text{* This is how narrowing works on monotone functions: you just iterate. *} - -abbreviation iter_down_mono :: "('a \ 'a) \ nat \ 'a \ 'a" where -"iter_down_mono f n x == ((\x. x \ f x)^^n) x" - -text{* Narrowing always yields a post-fixed point: *} - -lemma iter_down_mono_pfp: assumes "mono f" and "f x0 \ x0" -defines "x n == iter_down_mono f n x0" -shows "f(x n) \ x n" -proof (induction n) - case 0 show ?case by (simp add: x_def assms(2)) -next - case (Suc n) - have "f (x (Suc n)) = f(x n \ f(x n))" by(simp add: x_def) - also have "\ \ f(x n)" by(rule monoD[OF `mono f` narrow2[OF Suc]]) - also have "\ \ x n \ f(x n)" by(rule narrow1[OF Suc]) - also have "\ = x(Suc n)" by(simp add: x_def) - finally show ?case . -qed - -text{* Narrowing can only increase precision: *} - -lemma iter_down_down: assumes "mono f" and "f x0 \ x0" -defines "x n == iter_down_mono f n x0" -shows "x n \ x0" -proof (induction n) - case 0 show ?case by(simp add: x_def) -next - case (Suc n) - have "x(Suc n) = x n \ f(x n)" by(simp add: x_def) - also have "\ \ x n" unfolding x_def - by(rule narrow2[OF iter_down_mono_pfp[OF assms(1), OF assms(2)]]) - also have "\ \ x0" by(rule Suc) - finally show ?case . -qed - - -end - - -instantiation ivl :: WN -begin - -definition "widen_ivl ivl1 ivl2 = - ((*if is_empty ivl1 then ivl2 else if is_empty ivl2 then ivl1 else*) - case (ivl1,ivl2) of (I l1 h1, I l2 h2) \ - I (if le_option False l2 l1 \ l2 \ l1 then None else l2) - (if le_option True h1 h2 \ h1 \ h2 then None else h2))" - -definition "narrow_ivl ivl1 ivl2 = - ((*if is_empty ivl1 \ is_empty ivl2 then empty else*) - case (ivl1,ivl2) of (I l1 h1, I l2 h2) \ - I (if l1 = None then l2 else l1) - (if h1 = None then h2 else h1))" - -instance -proof qed - (auto simp add: widen_ivl_def narrow_ivl_def le_option_def le_ivl_def empty_def split: ivl.split option.split if_splits) - -end - -instantiation astate :: (WN) WN -begin - -definition "widen_astate F1 F2 = - FunDom (\x. fun F1 x \ fun F2 x) (inter_list (dom F1) (dom F2))" - -definition "narrow_astate F1 F2 = - FunDom (\x. fun F1 x \ fun F2 x) (inter_list (dom F1) (dom F2))" - -instance -proof - case goal1 thus ?case - by(simp add: widen_astate_def le_astate_def lookup_def widen) -next - case goal2 thus ?case - by(auto simp: narrow_astate_def le_astate_def lookup_def narrow1) -next - case goal3 thus ?case - by(auto simp: narrow_astate_def le_astate_def lookup_def narrow2) -qed - -end - -instantiation up :: (WN) WN -begin - -fun widen_up where -"widen_up bot x = x" | -"widen_up x bot = x" | -"widen_up (Up x) (Up y) = Up(x \ y)" - -fun narrow_up where -"narrow_up bot x = bot" | -"narrow_up x bot = bot" | -"narrow_up (Up x) (Up y) = Up(x \ y)" - -instance -proof - case goal1 show ?case - by(induct x y rule: widen_up.induct) (simp_all add: widen) -next - case goal2 thus ?case - by(induct x y rule: narrow_up.induct) (simp_all add: narrow1) -next - case goal3 thus ?case - by(induct x y rule: narrow_up.induct) (simp_all add: narrow2) -qed - -end - -interpretation - Abs_Int1 rep_ivl num_ivl plus_ivl filter_plus_ivl filter_less_ivl "(iter' 3 2)" -defines afilter_ivl' is afilter -and bfilter_ivl' is bfilter -and AI_ivl' is AI -and aval_ivl' is aval' -proof qed (auto simp: iter'_pfp_above) - -value [code] "list_up(AI_ivl' test3_ivl Top)" -value [code] "list_up(AI_ivl' test4_ivl Top)" -value [code] "list_up(AI_ivl' test5_ivl Top)" - -end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int_den0.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int_Den/Abs_Int_den0.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,67 @@ +(* Author: Tobias Nipkow *) + +theory Abs_Int_den0 +imports Abs_State_den +begin + +subsection "Computable Abstract Interpretation" + +text{* Abstract interpretation over type @{text astate} instead of +functions. *} + +locale Abs_Int = Val_abs + +fixes pfp :: "('a astate \ 'a astate) \ 'a astate \ 'a astate" +assumes pfp: "f(pfp f x0) \ pfp f x0" +assumes above: "x0 \ pfp f x0" +begin + +fun aval' :: "aexp \ 'a astate \ 'a" where +"aval' (N n) _ = num' n" | +"aval' (V x) S = lookup S x" | +"aval' (Plus e1 e2) S = plus' (aval' e1 S) (aval' e2 S)" + +abbreviation astate_in_rep (infix "<:" 50) where +"s <: S == ALL x. s x <: lookup S x" + +lemma astate_in_rep_le: "(s::state) <: S \ S \ T \ s <: T" +by (metis in_mono le_astate_def le_rep lookup_def top) + +lemma aval'_sound: "s <: S \ aval a s <: aval' a S" +by (induct a) (auto simp: rep_num' rep_plus') + + +fun AI :: "com \ 'a astate \ 'a astate" where +"AI SKIP S = S" | +"AI (x ::= a) S = update S x (aval' a S)" | +"AI (c1;c2) S = AI c2 (AI c1 S)" | +"AI (IF b THEN c1 ELSE c2) S = (AI c1 S) \ (AI c2 S)" | +"AI (WHILE b DO c) S = pfp (AI c) S" + +lemma AI_sound: "(c,s) \ t \ s <: S0 \ t <: AI c S0" +proof(induction c arbitrary: s t S0) + case SKIP thus ?case by fastforce +next + case Assign thus ?case + by (auto simp: lookup_update aval'_sound) +next + case Semi thus ?case by auto +next + case If thus ?case + by (metis AI.simps(4) IfE astate_in_rep_le join_ge1 join_ge2) +next + case (While b c) + let ?P = "pfp (AI c) S0" + { fix s t have "(WHILE b DO c,s) \ t \ s <: ?P \ t <: ?P" + proof(induction "WHILE b DO c" s t rule: big_step_induct) + case WhileFalse thus ?case by simp + next + case WhileTrue thus ?case using While.IH pfp astate_in_rep_le by metis + qed + } + with astate_in_rep_le[OF `s <: S0` above] + show ?case by (metis While(2) AI.simps(5)) +qed + +end + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int_den0_const.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int_Den/Abs_Int_den0_const.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,111 @@ +(* Author: Tobias Nipkow *) + +theory Abs_Int_den0_const +imports Abs_Int_den0 +begin + +subsection "Constant Propagation" + +datatype cval = Const val | Any + +fun rep_cval where +"rep_cval (Const n) = {n}" | +"rep_cval (Any) = UNIV" + +fun plus_cval where +"plus_cval (Const m) (Const n) = Const(m+n)" | +"plus_cval _ _ = Any" + +instantiation cval :: SL_top +begin + +fun le_cval where +"_ \ Any = True" | +"Const n \ Const m = (n=m)" | +"Any \ Const _ = False" + +fun join_cval where +"Const m \ Const n = (if n=m then Const m else Any)" | +"_ \ _ = Any" + +definition "Top = Any" + +instance +proof + case goal1 thus ?case by (cases x) simp_all +next + case goal2 thus ?case by(cases z, cases y, cases x, simp_all) +next + case goal3 thus ?case by(cases x, cases y, simp_all) +next + case goal4 thus ?case by(cases y, cases x, simp_all) +next + case goal5 thus ?case by(cases z, cases y, cases x, simp_all) +next + case goal6 thus ?case by(simp add: Top_cval_def) +qed + +end + +interpretation Rep rep_cval +proof + case goal1 thus ?case + by(cases a, cases b, simp, simp, cases b, simp, simp) +qed + +interpretation Val_abs rep_cval Const plus_cval +proof + case goal1 show ?case by simp +next + case goal2 thus ?case + by(cases a1, cases a2, simp, simp, cases a2, simp, simp) +qed + +interpretation Abs_Int rep_cval Const plus_cval "(iter' 3)" +defines AI_const is AI +and aval'_const is aval' +proof qed (auto simp: iter'_pfp_above) + +text{* Straight line code: *} +definition "test1_const = + ''y'' ::= N 7; + ''z'' ::= Plus (V ''y'') (N 2); + ''y'' ::= Plus (V ''x'') (N 0)" + +text{* Conditional: *} +definition "test2_const = + IF Less (N 41) (V ''x'') THEN ''x'' ::= N 5 ELSE ''x'' ::= N 5" + +text{* Conditional, test is ignored: *} +definition "test3_const = + ''x'' ::= N 42; + IF Less (N 41) (V ''x'') THEN ''x'' ::= N 5 ELSE ''x'' ::= N 6" + +text{* While: *} +definition "test4_const = + ''x'' ::= N 0; WHILE B True DO ''x'' ::= N 0" + +text{* While, test is ignored: *} +definition "test5_const = + ''x'' ::= N 0; WHILE Less (V ''x'') (N 1) DO ''x'' ::= N 1" + +text{* Iteration is needed: *} +definition "test6_const = + ''x'' ::= N 0; ''y'' ::= N 0; ''z'' ::= N 2; + WHILE Less (V ''x'') (N 1) DO (''x'' ::= V ''y''; ''y'' ::= V ''z'')" + +text{* More iteration would be needed: *} +definition "test7_const = + ''x'' ::= N 0; ''y'' ::= N 0; ''z'' ::= N 0; ''u'' ::= N 3; + WHILE Less (V ''x'') (N 1) + DO (''x'' ::= V ''y''; ''y'' ::= V ''z''; ''z'' ::= V ''u'')" + +value [code] "list (AI_const test1_const Top)" +value [code] "list (AI_const test2_const Top)" +value [code] "list (AI_const test3_const Top)" +value [code] "list (AI_const test4_const Top)" +value [code] "list (AI_const test5_const Top)" +value [code] "list (AI_const test6_const Top)" +value [code] "list (AI_const test7_const Top)" + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int_den0_fun.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int_Den/Abs_Int_den0_fun.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,187 @@ +(* Author: Tobias Nipkow *) + +header "Denotational Abstract Interpretation" + +theory Abs_Int_den0_fun +imports "~~/src/HOL/ex/Interpretation_with_Defs" Big_Step +begin + +subsection "Orderings" + +class preord = +fixes le :: "'a \ 'a \ bool" (infix "\" 50) +assumes le_refl[simp]: "x \ x" +and le_trans: "x \ y \ y \ z \ x \ z" + +text{* Note: no antisymmetry. Allows implementations where some abstract +element is implemented by two different values @{prop "x \ y"} +such that @{prop"x \ y"} and @{prop"y \ x"}. Antisymmetry is not +needed because we never compare elements for equality but only for @{text"\"}. +*} + +class SL_top = preord + +fixes join :: "'a \ 'a \ 'a" (infixl "\" 65) +fixes Top :: "'a" +assumes join_ge1 [simp]: "x \ x \ y" +and join_ge2 [simp]: "y \ x \ y" +and join_least: "x \ z \ y \ z \ x \ y \ z" +and top[simp]: "x \ Top" +begin + +lemma join_le_iff[simp]: "x \ y \ z \ x \ z \ y \ z" +by (metis join_ge1 join_ge2 join_least le_trans) + +fun iter :: "nat \ ('a \ 'a) \ 'a \ 'a" where +"iter 0 f _ = Top" | +"iter (Suc n) f x = (if f x \ x then x else iter n f (f x))" + +lemma iter_pfp: "f(iter n f x) \ iter n f x" +apply (induction n arbitrary: x) + apply (simp) +apply (simp) +done + +abbreviation iter' :: "nat \ ('a \ 'a) \ 'a \ 'a" where +"iter' n f x0 == iter n (\x. x0 \ f x) x0" + +lemma iter'_pfp_above: + "f(iter' n f x0) \ iter' n f x0" "x0 \ iter' n f x0" +using iter_pfp[of "\x. x0 \ f x"] by auto + +text{* So much for soundness. But how good an approximation of the post-fixed +point does @{const iter} yield? *} + +lemma iter_funpow: "iter n f x \ Top \ \k. iter n f x = (f^^k) x" +apply(induction n arbitrary: x) + apply simp +apply (auto) + apply(metis funpow.simps(1) id_def) +by (metis funpow.simps(2) funpow_swap1 o_apply) + +text{* For monotone @{text f}, @{term "iter f n x0"} yields the least +post-fixed point above @{text x0}, unless it yields @{text Top}. *} + +lemma iter_least_pfp: +assumes mono: "\x y. x \ y \ f x \ f y" and "iter n f x0 \ Top" +and "f p \ p" and "x0 \ p" shows "iter n f x0 \ p" +proof- + obtain k where "iter n f x0 = (f^^k) x0" + using iter_funpow[OF `iter n f x0 \ Top`] by blast + moreover + { fix n have "(f^^n) x0 \ p" + proof(induction n) + case 0 show ?case by(simp add: `x0 \ p`) + next + case (Suc n) thus ?case + by (simp add: `x0 \ p`)(metis Suc assms(3) le_trans mono) + qed + } ultimately show ?thesis by simp +qed + +end + +text{* The interface of abstract values: *} + +locale Rep = +fixes rep :: "'a::SL_top \ 'b set" +assumes le_rep: "a \ b \ rep a \ rep b" +begin + +abbreviation in_rep (infix "<:" 50) where "x <: a == x : rep a" + +lemma in_rep_join: "x <: a1 \ x <: a2 \ x <: a1 \ a2" +by (metis SL_top_class.join_ge1 SL_top_class.join_ge2 le_rep subsetD) + +end + +locale Val_abs = Rep rep + for rep :: "'a::SL_top \ val set" + +fixes num' :: "val \ 'a" +and plus' :: "'a \ 'a \ 'a" +assumes rep_num': "rep(num' n) = {n}" +and rep_plus': "n1 <: a1 \ n2 <: a2 \ n1+n2 <: plus' a1 a2" + + +instantiation "fun" :: (type, SL_top) SL_top +begin + +definition "f \ g = (ALL x. f x \ g x)" +definition "f \ g = (\x. f x \ g x)" +definition "Top = (\x. Top)" + +lemma join_apply[simp]: + "(f \ g) x = f x \ g x" +by (simp add: join_fun_def) + +instance +proof + case goal2 thus ?case by (metis le_fun_def preord_class.le_trans) +qed (simp_all add: le_fun_def Top_fun_def) + +end + +subsection "Abstract Interpretation Abstractly" + +text{* Abstract interpretation over abstract values. Abstract states are +simply functions. The post-fixed point finder is parameterized over. *} + +type_synonym 'a st = "name \ 'a" + +locale Abs_Int_Fun = Val_abs + +fixes pfp :: "('a st \ 'a st) \ 'a st \ 'a st" +assumes pfp: "f(pfp f x) \ pfp f x" +assumes above: "x \ pfp f x" +begin + +fun aval' :: "aexp \ (name \ 'a) \ 'a" where +"aval' (N n) _ = num' n" | +"aval' (V x) S = S x" | +"aval' (Plus a1 a2) S = plus' (aval' a1 S) (aval' a2 S)" + +abbreviation fun_in_rep (infix "<:" 50) where +"f <: F == \x. f x <: F x" + +lemma fun_in_rep_le: "(s::state) <: S \ S \ T \ s <: T" +by (metis le_fun_def le_rep subsetD) + +lemma aval'_sound: "s <: S \ aval a s <: aval' a S" +by (induct a) (auto simp: rep_num' rep_plus') + +fun AI :: "com \ (name \ 'a) \ (name \ 'a)" where +"AI SKIP S = S" | +"AI (x ::= a) S = S(x := aval' a S)" | +"AI (c1;c2) S = AI c2 (AI c1 S)" | +"AI (IF b THEN c1 ELSE c2) S = (AI c1 S) \ (AI c2 S)" | +"AI (WHILE b DO c) S = pfp (AI c) S" + +lemma AI_sound: "(c,s) \ t \ s <: S0 \ t <: AI c S0" +proof(induction c arbitrary: s t S0) + case SKIP thus ?case by fastforce +next + case Assign thus ?case by (auto simp: aval'_sound) +next + case Semi thus ?case by auto +next + case If thus ?case by(auto simp: in_rep_join) +next + case (While b c) + let ?P = "pfp (AI c) S0" + { fix s t have "(WHILE b DO c,s) \ t \ s <: ?P \ t <: ?P" + proof(induction "WHILE b DO c" s t rule: big_step_induct) + case WhileFalse thus ?case by simp + next + case WhileTrue thus ?case by(metis While.IH pfp fun_in_rep_le) + qed + } + with fun_in_rep_le[OF `s <: S0` above] + show ?case by (metis While(2) AI.simps(5)) +qed + +end + + +text{* Problem: not executable because of the comparison of abstract states, +i.e. functions, in the post-fixedpoint computation. Need to implement +abstract states concretely. *} + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int_den1.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int_Den/Abs_Int_den1.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,214 @@ +(* Author: Tobias Nipkow *) + +theory Abs_Int_den1 +imports Abs_Int_den0_const +begin + +subsection "Backward Analysis of Expressions" + +class L_top_bot = SL_top + +fixes meet :: "'a \ 'a \ 'a" (infixl "\" 65) +and Bot :: "'a" +assumes meet_le1 [simp]: "x \ y \ x" +and meet_le2 [simp]: "x \ y \ y" +and meet_greatest: "x \ y \ x \ z \ x \ y \ z" +assumes bot[simp]: "Bot \ x" + +locale Rep1 = Rep rep for rep :: "'a::L_top_bot \ 'b set" + +assumes inter_rep_subset_rep_meet: "rep a1 \ rep a2 \ rep(a1 \ a2)" +and rep_Bot: "rep Bot = {}" +begin + +lemma in_rep_meet: "x <: a1 \ x <: a2 \ x <: a1 \ a2" +by (metis IntI inter_rep_subset_rep_meet set_mp) + +lemma rep_meet[simp]: "rep(a1 \ a2) = rep a1 \ rep a2" +by (metis equalityI inter_rep_subset_rep_meet le_inf_iff le_rep meet_le1 meet_le2) + +end + + +locale Val_abs1 = Val_abs rep num' plus' + Rep1 rep + for rep :: "'a::L_top_bot \ int set" and num' plus' + +fixes filter_plus' :: "'a \ 'a \ 'a \ 'a * 'a" +and filter_less' :: "bool \ 'a \ 'a \ 'a * 'a" +assumes filter_plus': "filter_plus' a a1 a2 = (a1',a2') \ + n1 <: a1 \ n2 <: a2 \ n1+n2 <: a \ n1 <: a1' \ n2 <: a2'" +and filter_less': "filter_less' (n1 + n1 <: a1 \ n2 <: a2 \ n1 <: a1' \ n2 <: a2'" + +datatype 'a up = bot | Up 'a + +instantiation up :: (SL_top)SL_top +begin + +fun le_up where +"Up x \ Up y = (x \ y)" | +"bot \ y = True" | +"Up _ \ bot = False" + +lemma [simp]: "(x \ bot) = (x = bot)" +by (cases x) simp_all + +lemma [simp]: "(Up x \ u) = (EX y. u = Up y & x \ y)" +by (cases u) auto + +fun join_up where +"Up x \ Up y = Up(x \ y)" | +"bot \ y = y" | +"x \ bot = x" + +lemma [simp]: "x \ bot = x" +by (cases x) simp_all + + +definition "Top = Up Top" + +instance proof + case goal1 show ?case by(cases x, simp_all) +next + case goal2 thus ?case + by(cases z, simp, cases y, simp, cases x, auto intro: le_trans) +next + case goal3 thus ?case by(cases x, simp, cases y, simp_all) +next + case goal4 thus ?case by(cases y, simp, cases x, simp_all) +next + case goal5 thus ?case by(cases z, simp, cases y, simp, cases x, simp_all) +next + case goal6 thus ?case by(cases x, simp_all add: Top_up_def) +qed + +end + + +locale Abs_Int1 = Val_abs1 + +fixes pfp :: "('a astate up \ 'a astate up) \ 'a astate up \ 'a astate up" +assumes pfp: "f(pfp f x0) \ pfp f x0" +assumes above: "x0 \ pfp f x0" +begin + +(* FIXME avoid duplicating this defn *) +abbreviation astate_in_rep (infix "<:" 50) where +"s <: S == ALL x. s x <: lookup S x" + +abbreviation in_rep_up :: "state \ 'a astate up \ bool" (infix "<::" 50) where +"s <:: S == EX S0. S = Up S0 \ s <: S0" + +lemma in_rep_up_trans: "(s::state) <:: S \ S \ T \ s <:: T" +apply auto +by (metis in_mono le_astate_def le_rep lookup_def top) + +lemma in_rep_join_UpI: "s <:: S1 | s <:: S2 \ s <:: S1 \ S2" +by (metis in_rep_up_trans SL_top_class.join_ge1 SL_top_class.join_ge2) + +fun aval' :: "aexp \ 'a astate up \ 'a" ("aval\<^isup>#") where +"aval' _ bot = Bot" | +"aval' (N n) _ = num' n" | +"aval' (V x) (Up S) = lookup S x" | +"aval' (Plus a1 a2) S = plus' (aval' a1 S) (aval' a2 S)" + +lemma aval'_sound: "s <:: S \ aval a s <: aval' a S" +by (induct a) (auto simp: rep_num' rep_plus') + +fun afilter :: "aexp \ 'a \ 'a astate up \ 'a astate up" where +"afilter (N n) a S = (if n <: a then S else bot)" | +"afilter (V x) a S = (case S of bot \ bot | Up S \ + let a' = lookup S x \ a in + if a' \ Bot then bot else Up(update S x a'))" | +"afilter (Plus e1 e2) a S = + (let (a1,a2) = filter_plus' a (aval' e1 S) (aval' e2 S) + in afilter e1 a1 (afilter e2 a2 S))" + +text{* The test for @{const Bot} in the @{const V}-case is important: @{const +Bot} indicates that a variable has no possible values, i.e.\ that the current +program point is unreachable. But then the abstract state should collapse to +@{const bot}. Put differently, we maintain the invariant that in an abstract +state all variables are mapped to non-@{const Bot} values. Otherwise the +(pointwise) join of two abstract states, one of which contains @{const Bot} +values, may produce too large a result, thus making the analysis less +precise. *} + + +fun bfilter :: "bexp \ bool \ 'a astate up \ 'a astate up" where +"bfilter (B bv) res S = (if bv=res then S else bot)" | +"bfilter (Not b) res S = bfilter b (\ res) S" | +"bfilter (And b1 b2) res S = + (if res then bfilter b1 True (bfilter b2 True S) + else bfilter b1 False S \ bfilter b2 False S)" | +"bfilter (Less e1 e2) res S = + (let (res1,res2) = filter_less' res (aval' e1 S) (aval' e2 S) + in afilter e1 res1 (afilter e2 res2 S))" + +lemma afilter_sound: "s <:: S \ aval e s <: a \ s <:: afilter e a S" +proof(induction e arbitrary: a S) + case N thus ?case by simp +next + case (V x) + obtain S' where "S = Up S'" and "s <: S'" using `s <:: S` by auto + moreover hence "s x <: lookup S' x" by(simp) + moreover have "s x <: a" using V by simp + ultimately show ?case using V(1) + by(simp add: lookup_update Let_def) + (metis le_rep emptyE in_rep_meet rep_Bot subset_empty) +next + case (Plus e1 e2) thus ?case + using filter_plus'[OF _ aval'_sound[OF Plus(3)] aval'_sound[OF Plus(3)]] + by (auto split: prod.split) +qed + +lemma bfilter_sound: "s <:: S \ bv = bval b s \ s <:: bfilter b bv S" +proof(induction b arbitrary: S bv) + case B thus ?case by simp +next + case (Not b) thus ?case by simp +next + case (And b1 b2) thus ?case by (auto simp: in_rep_join_UpI) +next + case (Less e1 e2) thus ?case + by (auto split: prod.split) + (metis afilter_sound filter_less' aval'_sound Less) +qed + +fun AI :: "com \ 'a astate up \ 'a astate up" where +"AI SKIP S = S" | +"AI (x ::= a) S = + (case S of bot \ bot | Up S \ Up(update S x (aval' a (Up S))))" | +"AI (c1;c2) S = AI c2 (AI c1 S)" | +"AI (IF b THEN c1 ELSE c2) S = + AI c1 (bfilter b True S) \ AI c2 (bfilter b False S)" | +"AI (WHILE b DO c) S = + bfilter b False (pfp (\S. AI c (bfilter b True S)) S)" + +lemma AI_sound: "(c,s) \ t \ s <:: S \ t <:: AI c S" +proof(induction c arbitrary: s t S) + case SKIP thus ?case by fastforce +next + case Assign thus ?case + by (auto simp: lookup_update aval'_sound) +next + case Semi thus ?case by fastforce +next + case If thus ?case by (auto simp: in_rep_join_UpI bfilter_sound) +next + case (While b c) + let ?P = "pfp (\S. AI c (bfilter b True S)) S" + { fix s t + have "(WHILE b DO c,s) \ t \ s <:: ?P \ + t <:: bfilter b False ?P" + proof(induction "WHILE b DO c" s t rule: big_step_induct) + case WhileFalse thus ?case by(metis bfilter_sound) + next + case WhileTrue show ?case + by(rule WhileTrue, rule in_rep_up_trans[OF _ pfp], + rule While.IH[OF WhileTrue(2)], + rule bfilter_sound[OF WhileTrue.prems], simp add: WhileTrue(1)) + qed + } + with in_rep_up_trans[OF `s <:: S` above] While(2,3) AI.simps(5) + show ?case by simp +qed + +end + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int_den1_ivl.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int_Den/Abs_Int_den1_ivl.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,260 @@ +(* Author: Tobias Nipkow *) + +theory Abs_Int_den1_ivl +imports Abs_Int_den1 +begin + +subsection "Interval Analysis" + +datatype ivl = I "int option" "int option" + +text{* We assume an important invariant: arithmetic operations are never +applied to empty intervals @{term"I (Some i) (Some j)"} with @{term"j < +i"}. This avoids special cases. Why can we assume this? Because an empty +interval of values for a variable means that the current program point is +unreachable. But this should actually translate into the bottom state, not a +state where some variables have empty intervals. *} + +definition "rep_ivl i = + (case i of I (Some l) (Some h) \ {l..h} | I (Some l) None \ {l..} + | I None (Some h) \ {..h} | I None None \ UNIV)" + +definition "num_ivl n = I (Some n) (Some n)" + +instantiation option :: (plus)plus +begin + +fun plus_option where +"Some x + Some y = Some(x+y)" | +"_ + _ = None" + +instance proof qed + +end + +definition empty where "empty = I (Some 1) (Some 0)" + +fun is_empty where +"is_empty(I (Some l) (Some h)) = (h (case h of Some h \ h False) | None \ False)" +by(auto split:option.split) + +lemma [simp]: "is_empty i \ rep_ivl i = {}" +by(auto simp add: rep_ivl_def split: ivl.split option.split) + +definition "plus_ivl i1 i2 = ((*if is_empty i1 | is_empty i2 then empty else*) + case (i1,i2) of (I l1 h1, I l2 h2) \ I (l1+l2) (h1+h2))" + +instantiation ivl :: SL_top +begin + +definition le_option :: "bool \ int option \ int option \ bool" where +"le_option pos x y = + (case x of (Some i) \ (case y of Some j \ i\j | None \ pos) + | None \ (case y of Some j \ \pos | None \ True))" + +fun le_aux where +"le_aux (I l1 h1) (I l2 h2) = (le_option False l2 l1 & le_option True h1 h2)" + +definition le_ivl where +"i1 \ i2 = + (if is_empty i1 then True else + if is_empty i2 then False else le_aux i1 i2)" + +definition min_option :: "bool \ int option \ int option \ int option" where +"min_option pos o1 o2 = (if le_option pos o1 o2 then o1 else o2)" + +definition max_option :: "bool \ int option \ int option \ int option" where +"max_option pos o1 o2 = (if le_option pos o1 o2 then o2 else o1)" + +definition "i1 \ i2 = + (if is_empty i1 then i2 else if is_empty i2 then i1 + else case (i1,i2) of (I l1 h1, I l2 h2) \ + I (min_option False l1 l2) (max_option True h1 h2))" + +definition "Top = I None None" + +instance +proof + case goal1 thus ?case + by(cases x, simp add: le_ivl_def le_option_def split: option.split) +next + case goal2 thus ?case + by(cases x, cases y, cases z, auto simp: le_ivl_def le_option_def split: option.splits if_splits) +next + case goal3 thus ?case + by(cases x, cases y, simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits) +next + case goal4 thus ?case + by(cases x, cases y, simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits) +next + case goal5 thus ?case + by(cases x, cases y, cases z, auto simp add: le_ivl_def join_ivl_def le_option_def min_option_def max_option_def split: option.splits if_splits) +next + case goal6 thus ?case + by(cases x, simp add: Top_ivl_def le_ivl_def le_option_def split: option.split) +qed + +end + + +instantiation ivl :: L_top_bot +begin + +definition "i1 \ i2 = (if is_empty i1 \ is_empty i2 then empty else + case (i1,i2) of (I l1 h1, I l2 h2) \ + I (max_option False l1 l2) (min_option True h1 h2))" + +definition "Bot = empty" + +instance +proof + case goal1 thus ?case + by (simp add:meet_ivl_def empty_def meet_ivl_def le_ivl_def le_option_def max_option_def min_option_def split: ivl.splits option.splits) +next + case goal2 thus ?case + by (simp add:meet_ivl_def empty_def meet_ivl_def le_ivl_def le_option_def max_option_def min_option_def split: ivl.splits option.splits) +next + case goal3 thus ?case + by (cases x, cases y, cases z, auto simp add: le_ivl_def meet_ivl_def empty_def le_option_def max_option_def min_option_def split: option.splits if_splits) +next + case goal4 show ?case by(cases x, simp add: Bot_ivl_def empty_def le_ivl_def) +qed + +end + +instantiation option :: (minus)minus +begin + +fun minus_option where +"Some x - Some y = Some(x-y)" | +"_ - _ = None" + +instance proof qed + +end + +definition "minus_ivl i1 i2 = ((*if is_empty i1 | is_empty i2 then empty else*) + case (i1,i2) of (I l1 h1, I l2 h2) \ I (l1-h2) (h1-l2))" + +lemma rep_minus_ivl: + "n1 : rep_ivl i1 \ n2 : rep_ivl i2 \ n1-n2 : rep_ivl(minus_ivl i1 i2)" +by(auto simp add: minus_ivl_def rep_ivl_def split: ivl.splits option.splits) + + +definition "filter_plus_ivl i i1 i2 = ((*if is_empty i then empty else*) + i1 \ minus_ivl i i2, i2 \ minus_ivl i i1)" + +fun filter_less_ivl :: "bool \ ivl \ ivl \ ivl * ivl" where +"filter_less_ivl res (I l1 h1) (I l2 h2) = + ((*if is_empty(I l1 h1) \ is_empty(I l2 h2) then (empty, empty) else*) + if res + then (I l1 (min_option True h1 (h2 - Some 1)), + I (max_option False (l1 + Some 1) l2) h2) + else (I (max_option False l1 l2) h1, I l2 (min_option True h1 h2)))" + +interpretation Rep rep_ivl +proof + case goal1 thus ?case + by(auto simp: rep_ivl_def le_ivl_def le_option_def split: ivl.split option.split if_splits) +qed + +interpretation Val_abs rep_ivl num_ivl plus_ivl +proof + case goal1 thus ?case by(simp add: rep_ivl_def num_ivl_def) +next + case goal2 thus ?case + by(auto simp add: rep_ivl_def plus_ivl_def split: ivl.split option.splits) +qed + +interpretation Rep1 rep_ivl +proof + case goal1 thus ?case + by(auto simp add: rep_ivl_def meet_ivl_def empty_def min_option_def max_option_def split: ivl.split option.split) +next + case goal2 show ?case by(auto simp add: Bot_ivl_def rep_ivl_def empty_def) +qed + +interpretation + Val_abs1 rep_ivl num_ivl plus_ivl filter_plus_ivl filter_less_ivl +proof + case goal1 thus ?case + by(auto simp add: filter_plus_ivl_def) + (metis rep_minus_ivl add_diff_cancel add_commute)+ +next + case goal2 thus ?case + by(cases a1, cases a2, + auto simp: rep_ivl_def min_option_def max_option_def le_option_def split: if_splits option.splits) +qed + +interpretation + Abs_Int1 rep_ivl num_ivl plus_ivl filter_plus_ivl filter_less_ivl "(iter' 3)" +defines afilter_ivl is afilter +and bfilter_ivl is bfilter +and AI_ivl is AI +and aval_ivl is aval' +proof qed (auto simp: iter'_pfp_above) + + +fun list_up where +"list_up bot = bot" | +"list_up (Up x) = Up(list x)" + +value [code] "list_up(afilter_ivl (N 5) (I (Some 4) (Some 5)) Top)" +value [code] "list_up(afilter_ivl (N 5) (I (Some 4) (Some 4)) Top)" +value [code] "list_up(afilter_ivl (V ''x'') (I (Some 4) (Some 4)) + (Up(FunDom(Top(''x'':=I (Some 5) (Some 6))) [''x''])))" +value [code] "list_up(afilter_ivl (V ''x'') (I (Some 4) (Some 5)) + (Up(FunDom(Top(''x'':=I (Some 5) (Some 6))) [''x''])))" +value [code] "list_up(afilter_ivl (Plus (V ''x'') (V ''x'')) (I (Some 0) (Some 10)) + (Up(FunDom(Top(''x'':= I (Some 0) (Some 100)))[''x''])))" +value [code] "list_up(afilter_ivl (Plus (V ''x'') (N 7)) (I (Some 0) (Some 10)) + (Up(FunDom(Top(''x'':= I (Some 0) (Some 100)))[''x''])))" + +value [code] "list_up(bfilter_ivl (Less (V ''x'') (V ''x'')) True + (Up(FunDom(Top(''x'':= I (Some 0) (Some 0)))[''x''])))" +value [code] "list_up(bfilter_ivl (Less (V ''x'') (V ''x'')) True + (Up(FunDom(Top(''x'':= I (Some 0) (Some 2)))[''x''])))" +value [code] "list_up(bfilter_ivl (Less (V ''x'') (Plus (N 10) (V ''y''))) True + (Up(FunDom(Top(''x'':= I (Some 15) (Some 20),''y'':= I (Some 5) (Some 7)))[''x'', ''y''])))" + +definition "test_ivl1 = + ''y'' ::= N 7; + IF Less (V ''x'') (V ''y'') + THEN ''y'' ::= Plus (V ''y'') (V ''x'') + ELSE ''x'' ::= Plus (V ''x'') (V ''y'')" +value [code] "list_up(AI_ivl test_ivl1 Top)" + +value "list_up (AI_ivl test3_const Top)" + +value "list_up (AI_ivl test5_const Top)" + +value "list_up (AI_ivl test6_const Top)" + +definition "test2_ivl = + ''y'' ::= N 7; + WHILE Less (V ''x'') (N 100) DO ''y'' ::= Plus (V ''y'') (N 1)" +value [code] "list_up(AI_ivl test2_ivl Top)" + +definition "test3_ivl = + ''x'' ::= N 0; ''y'' ::= N 100; ''z'' ::= Plus (V ''x'') (V ''y''); + WHILE Less (V ''x'') (N 11) + DO (''x'' ::= Plus (V ''x'') (N 1); ''y'' ::= Plus (V ''y'') (N -1))" +value [code] "list_up(AI_ivl test3_ivl Top)" + +definition "test4_ivl = + ''x'' ::= N 0; ''y'' ::= N 0; + WHILE Less (V ''x'') (N 1001) + DO (''y'' ::= V ''x''; ''x'' ::= Plus (V ''x'') (N 1))" +value [code] "list_up(AI_ivl test4_ivl Top)" + +text{* Nontermination not detected: *} +definition "test5_ivl = + ''x'' ::= N 0; + WHILE Less (V ''x'') (N 1) DO ''x'' ::= Plus (V ''x'') (N -1)" +value [code] "list_up(AI_ivl test5_ivl Top)" + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_Int_den2.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int_Den/Abs_Int_den2.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,207 @@ +(* Author: Tobias Nipkow *) + +theory Abs_Int_den2 +imports Abs_Int_den1_ivl +begin + +context preord +begin + +definition mono where "mono f = (\x y. x \ y \ f x \ f y)" + +lemma monoD: "mono f \ x \ y \ f x \ f y" by(simp add: mono_def) + +lemma mono_comp: "mono f \ mono g \ mono (g o f)" +by(simp add: mono_def) + +declare le_trans[trans] + +end + + +subsection "Widening and Narrowing" + +text{* Jumping to the trivial post-fixed point @{const Top} in case @{text k} +rounds of iteration did not reach a post-fixed point (as in @{const iter}) is +a trivial widening step. We generalise this idea and complement it with +narrowing, a process to regain precision. + +Class @{text WN} makes some assumptions about the widening and narrowing +operators. The assumptions serve two purposes. Together with a further +assumption that certain chains become stationary, they permit to prove +termination of the fixed point iteration, which we do not --- we limit the +number of iterations as before. The second purpose of the narrowing +assumptions is to prove that the narrowing iteration keeps on producing +post-fixed points and that it goes down. However, this requires the function +being iterated to be monotone. Unfortunately, abstract interpretation with +widening is not monotone. Hence the (recursive) abstract interpretation of a +loop body that again contains a loop may result in a non-monotone +function. Therefore our narrowing iteration needs to check at every step +that a post-fixed point is maintained, and we cannot prove that the precision +increases. *} + +class WN = SL_top + +fixes widen :: "'a \ 'a \ 'a" (infix "\" 65) +assumes widen: "y \ x \ y" +fixes narrow :: "'a \ 'a \ 'a" (infix "\" 65) +assumes narrow1: "y \ x \ y \ x \ y" +assumes narrow2: "y \ x \ x \ y \ x" +begin + +fun iter_up :: "('a \ 'a) \ nat \ 'a \ 'a" where +"iter_up f 0 x = Top" | +"iter_up f (Suc n) x = + (let fx = f x in if fx \ x then x else iter_up f n (x \ fx))" + +lemma iter_up_pfp: "f(iter_up f n x) \ iter_up f n x" +apply (induction n arbitrary: x) + apply (simp) +apply (simp add: Let_def) +done + +fun iter_down :: "('a \ 'a) \ nat \ 'a \ 'a" where +"iter_down f 0 x = x" | +"iter_down f (Suc n) x = + (let y = x \ f x in if f y \ y then iter_down f n y else x)" + +lemma iter_down_pfp: "f x \ x \ f(iter_down f n x) \ iter_down f n x" +apply (induction n arbitrary: x) + apply (simp) +apply (simp add: Let_def) +done + +definition iter' :: "nat \ nat \ ('a \ 'a) \ 'a \ 'a" where +"iter' m n f x = + (let f' = (\y. x \ f y) in iter_down f' n (iter_up f' m x))" + +lemma iter'_pfp_above: +shows "f(iter' m n f x0) \ iter' m n f x0" +and "x0 \ iter' m n f x0" +using iter_up_pfp[of "\x. x0 \ f x"] iter_down_pfp[of "\x. x0 \ f x"] +by(auto simp add: iter'_def Let_def) + +text{* This is how narrowing works on monotone functions: you just iterate. *} + +abbreviation iter_down_mono :: "('a \ 'a) \ nat \ 'a \ 'a" where +"iter_down_mono f n x == ((\x. x \ f x)^^n) x" + +text{* Narrowing always yields a post-fixed point: *} + +lemma iter_down_mono_pfp: assumes "mono f" and "f x0 \ x0" +defines "x n == iter_down_mono f n x0" +shows "f(x n) \ x n" +proof (induction n) + case 0 show ?case by (simp add: x_def assms(2)) +next + case (Suc n) + have "f (x (Suc n)) = f(x n \ f(x n))" by(simp add: x_def) + also have "\ \ f(x n)" by(rule monoD[OF `mono f` narrow2[OF Suc]]) + also have "\ \ x n \ f(x n)" by(rule narrow1[OF Suc]) + also have "\ = x(Suc n)" by(simp add: x_def) + finally show ?case . +qed + +text{* Narrowing can only increase precision: *} + +lemma iter_down_down: assumes "mono f" and "f x0 \ x0" +defines "x n == iter_down_mono f n x0" +shows "x n \ x0" +proof (induction n) + case 0 show ?case by(simp add: x_def) +next + case (Suc n) + have "x(Suc n) = x n \ f(x n)" by(simp add: x_def) + also have "\ \ x n" unfolding x_def + by(rule narrow2[OF iter_down_mono_pfp[OF assms(1), OF assms(2)]]) + also have "\ \ x0" by(rule Suc) + finally show ?case . +qed + + +end + + +instantiation ivl :: WN +begin + +definition "widen_ivl ivl1 ivl2 = + ((*if is_empty ivl1 then ivl2 else if is_empty ivl2 then ivl1 else*) + case (ivl1,ivl2) of (I l1 h1, I l2 h2) \ + I (if le_option False l2 l1 \ l2 \ l1 then None else l2) + (if le_option True h1 h2 \ h1 \ h2 then None else h2))" + +definition "narrow_ivl ivl1 ivl2 = + ((*if is_empty ivl1 \ is_empty ivl2 then empty else*) + case (ivl1,ivl2) of (I l1 h1, I l2 h2) \ + I (if l1 = None then l2 else l1) + (if h1 = None then h2 else h1))" + +instance +proof qed + (auto simp add: widen_ivl_def narrow_ivl_def le_option_def le_ivl_def empty_def split: ivl.split option.split if_splits) + +end + +instantiation astate :: (WN) WN +begin + +definition "widen_astate F1 F2 = + FunDom (\x. fun F1 x \ fun F2 x) (inter_list (dom F1) (dom F2))" + +definition "narrow_astate F1 F2 = + FunDom (\x. fun F1 x \ fun F2 x) (inter_list (dom F1) (dom F2))" + +instance +proof + case goal1 thus ?case + by(simp add: widen_astate_def le_astate_def lookup_def widen) +next + case goal2 thus ?case + by(auto simp: narrow_astate_def le_astate_def lookup_def narrow1) +next + case goal3 thus ?case + by(auto simp: narrow_astate_def le_astate_def lookup_def narrow2) +qed + +end + +instantiation up :: (WN) WN +begin + +fun widen_up where +"widen_up bot x = x" | +"widen_up x bot = x" | +"widen_up (Up x) (Up y) = Up(x \ y)" + +fun narrow_up where +"narrow_up bot x = bot" | +"narrow_up x bot = bot" | +"narrow_up (Up x) (Up y) = Up(x \ y)" + +instance +proof + case goal1 show ?case + by(induct x y rule: widen_up.induct) (simp_all add: widen) +next + case goal2 thus ?case + by(induct x y rule: narrow_up.induct) (simp_all add: narrow1) +next + case goal3 thus ?case + by(induct x y rule: narrow_up.induct) (simp_all add: narrow2) +qed + +end + +interpretation + Abs_Int1 rep_ivl num_ivl plus_ivl filter_plus_ivl filter_less_ivl "(iter' 3 2)" +defines afilter_ivl' is afilter +and bfilter_ivl' is bfilter +and AI_ivl' is AI +and aval_ivl' is aval' +proof qed (auto simp: iter'_pfp_above) + +value [code] "list_up(AI_ivl' test3_ivl Top)" +value [code] "list_up(AI_ivl' test4_ivl Top)" +value [code] "list_up(AI_ivl' test5_ivl Top)" + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_State.thy --- a/src/HOL/IMP/Abs_Int_Den/Abs_State.thy Wed Sep 28 08:51:55 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,50 +0,0 @@ -(* Author: Tobias Nipkow *) - -theory Abs_State -imports Abs_Int0_fun - "~~/src/HOL/Library/Char_ord" "~~/src/HOL/Library/List_lexord" - (* Library import merely to allow string lists to be sorted for output *) -begin - -subsection "Abstract State with Computable Ordering" - -text{* A concrete type of state with computable @{text"\"}: *} - -datatype 'a astate = FunDom "string \ 'a" "string list" - -fun "fun" where "fun (FunDom f _) = f" -fun dom where "dom (FunDom _ A) = A" - -definition [simp]: "inter_list xs ys = [x\xs. x \ set ys]" - -definition "list S = [(x,fun S x). x \ sort(dom S)]" - -definition "lookup F x = (if x : set(dom F) then fun F x else Top)" - -definition "update F x y = - FunDom ((fun F)(x:=y)) (if x \ set(dom F) then dom F else x # dom F)" - -lemma lookup_update: "lookup (update S x y) = (lookup S)(x:=y)" -by(rule ext)(auto simp: lookup_def update_def) - -instantiation astate :: (SL_top) SL_top -begin - -definition "le_astate F G = (ALL x : set(dom G). lookup F x \ fun G x)" - -definition -"join_astate F G = - FunDom (\x. fun F x \ fun G x) (inter_list (dom F) (dom G))" - -definition "Top = FunDom (\x. Top) []" - -instance -proof - case goal2 thus ?case - apply(auto simp: le_astate_def) - by (metis lookup_def preord_class.le_trans top) -qed (auto simp: le_astate_def lookup_def join_astate_def Top_astate_def) - -end - -end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_Int_Den/Abs_State_den.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_Int_Den/Abs_State_den.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,50 @@ +(* Author: Tobias Nipkow *) + +theory Abs_State_den +imports Abs_Int_den0_fun + "~~/src/HOL/Library/Char_ord" "~~/src/HOL/Library/List_lexord" + (* Library import merely to allow string lists to be sorted for output *) +begin + +subsection "Abstract State with Computable Ordering" + +text{* A concrete type of state with computable @{text"\"}: *} + +datatype 'a astate = FunDom "string \ 'a" "string list" + +fun "fun" where "fun (FunDom f _) = f" +fun dom where "dom (FunDom _ A) = A" + +definition [simp]: "inter_list xs ys = [x\xs. x \ set ys]" + +definition "list S = [(x,fun S x). x \ sort(dom S)]" + +definition "lookup F x = (if x : set(dom F) then fun F x else Top)" + +definition "update F x y = + FunDom ((fun F)(x:=y)) (if x \ set(dom F) then dom F else x # dom F)" + +lemma lookup_update: "lookup (update S x y) = (lookup S)(x:=y)" +by(rule ext)(auto simp: lookup_def update_def) + +instantiation astate :: (SL_top) SL_top +begin + +definition "le_astate F G = (ALL x : set(dom G). lookup F x \ fun G x)" + +definition +"join_astate F G = + FunDom (\x. fun F x \ fun G x) (inter_list (dom F) (dom G))" + +definition "Top = FunDom (\x. Top) []" + +instance +proof + case goal2 thus ?case + apply(auto simp: le_astate_def) + by (metis lookup_def preord_class.le_trans top) +qed (auto simp: le_astate_def lookup_def join_astate_def Top_astate_def) + +end + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/Abs_State.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/IMP/Abs_State.thy Wed Sep 28 09:55:11 2011 +0200 @@ -0,0 +1,95 @@ +(* Author: Tobias Nipkow *) + +theory Abs_State +imports Abs_Int0_fun + "~~/src/HOL/Library/Char_ord" "~~/src/HOL/Library/List_lexord" + (* Library import merely to allow string lists to be sorted for output *) +begin + +subsection "Abstract State with Computable Ordering" + +text{* A concrete type of state with computable @{text"\"}: *} + +datatype 'a st = FunDom "name \ 'a" "name list" + +fun "fun" where "fun (FunDom f _) = f" +fun dom where "dom (FunDom _ A) = A" + +definition [simp]: "inter_list xs ys = [x\xs. x \ set ys]" + +definition "show_st S = [(x,fun S x). x \ sort(dom S)]" + +fun show_st_up where +"show_st_up Bot = Bot" | +"show_st_up (Up S) = Up(show_st S)" + +definition "show_acom = map_acom show_st_up" + +definition "lookup F x = (if x : set(dom F) then fun F x else \)" + +definition "update F x y = + FunDom ((fun F)(x:=y)) (if x \ set(dom F) then dom F else x # dom F)" + +lemma lookup_update: "lookup (update S x y) = (lookup S)(x:=y)" +by(rule ext)(auto simp: lookup_def update_def) + +definition "rep_st rep F = {f. \x. f x \ rep(lookup F x)}" + +instantiation st :: (SL_top) SL_top +begin + +definition "le_st F G = (ALL x : set(dom G). lookup F x \ fun G x)" + +definition +"join_st F G = + FunDom (\x. fun F x \ fun G x) (inter_list (dom F) (dom G))" + +definition "\ = FunDom (\x. \) []" + +instance +proof + case goal2 thus ?case + apply(auto simp: le_st_def) + by (metis lookup_def preord_class.le_trans top) +qed (auto simp: le_st_def lookup_def join_st_def Top_st_def) + +end + +lemma mono_lookup: "F \ F' \ lookup F x \ lookup F' x" +by(auto simp add: lookup_def le_st_def) + +lemma mono_update: "a \ a' \ S \ S' \ update S x a \ update S' x a'" +by(auto simp add: le_st_def lookup_def update_def) + +context Rep +begin + +abbreviation fun_in_rep :: "(name \ 'b) \ 'a st \ bool" (infix "<:f" 50) where +"s <:f S == s \ rep_st rep S" + +notation fun_in_rep (infix "<:\<^sub>f" 50) + +lemma fun_in_rep_le: "s <:f S \ S \ T \ s <:f T" +apply(auto simp add: rep_st_def le_st_def dest: le_rep) +by (metis in_rep_Top le_rep lookup_def subsetD) + +abbreviation in_rep_up :: "(name \ 'b) \ 'a st up \ bool" (infix "<:up" 50) +where "s <:up S == s : rep_up (rep_st rep) S" + +notation (output) in_rep_up (infix "<:\<^sub>u\<^sub>p" 50) + +lemma up_fun_in_rep_le: "s <:up S \ S \ T \ s <:up T" +by (cases S) (auto intro:fun_in_rep_le) + +lemma in_rep_up_iff: "x <:up u \ (\u'. u = Up u' \ x <:f u')" +by (cases u) auto + +lemma in_rep_Top_fun: "s <:f \" +by(simp add: rep_st_def lookup_def Top_st_def) + +lemma in_rep_Top_up: "s <:up \" +by(simp add: Top_up_def in_rep_Top_fun) + +end + +end diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IMP/ROOT.ML --- a/src/HOL/IMP/ROOT.ML Wed Sep 28 08:51:55 2011 +0200 +++ b/src/HOL/IMP/ROOT.ML Wed Sep 28 09:55:11 2011 +0200 @@ -18,7 +18,8 @@ "Hoare_Examples", "VC", "HoareT", - "Abs_Int_Den/Abs_Int2", + "Abs_Int2", + "Abs_Int_Den/Abs_Int_den2", "Procs_Dyn_Vars_Dyn", "Procs_Stat_Vars_Dyn", "Procs_Stat_Vars_Stat", diff -r 305f83b6da54 -r 054a9ac0d7ef src/HOL/IsaMakefile --- a/src/HOL/IsaMakefile Wed Sep 28 08:51:55 2011 +0200 +++ b/src/HOL/IsaMakefile Wed Sep 28 09:55:11 2011 +0200 @@ -515,10 +515,10 @@ HOL-IMP: HOL $(OUT)/HOL-IMP -$(OUT)/HOL-IMP: $(OUT)/HOL IMP/Abs_Int_Den/Abs_Int0_fun.thy \ - IMP/Abs_Int_Den/Abs_State.thy IMP/Abs_Int_Den/Abs_Int0.thy \ - IMP/Abs_Int_Den/Abs_Int0_const.thy IMP/Abs_Int_Den/Abs_Int1.thy \ - IMP/Abs_Int_Den/Abs_Int1_ivl.thy IMP/Abs_Int_Den/Abs_Int2.thy \ +$(OUT)/HOL-IMP: $(OUT)/HOL IMP/Abs_Int_Den/Abs_Int_den0_fun.thy \ + IMP/Abs_Int_Den/Abs_State_den.thy IMP/Abs_Int_Den/Abs_Int_den0.thy \ + IMP/Abs_Int_Den/Abs_Int_den0_const.thy IMP/Abs_Int_Den/Abs_Int_den1.thy \ + IMP/Abs_Int_Den/Abs_Int_den1_ivl.thy IMP/Abs_Int_Den/Abs_Int_den2.thy \ IMP/ASM.thy IMP/AExp.thy IMP/BExp.thy \ IMP/Big_Step.thy IMP/C_like.thy IMP/Com.thy IMP/Compiler.thy \ IMP/Comp_Rev.thy IMP/Def_Ass.thy IMP/Def_Ass_Big.thy IMP/Def_Ass_Exp.thy \