# HG changeset patch # User nipkow # Date 1348622200 -7200 # Node ID 1c73b107d20d0c436bf60b9e8cade8177d745eea # Parent 10f9f8608b4d5743f8e18535c709270c4deb7a56 tuned diff -r 10f9f8608b4d -r 1c73b107d20d src/HOL/IMP/Abs_Int2_ivl.thy --- a/src/HOL/IMP/Abs_Int2_ivl.thy Wed Sep 26 03:03:11 2012 +0200 +++ b/src/HOL/IMP/Abs_Int2_ivl.thy Wed Sep 26 03:16:40 2012 +0200 @@ -6,30 +6,30 @@ subsection "Interval Analysis" -datatype ivl = I "int option" "int option" +datatype ivl = Ivl "int option" "int option" definition "\_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)" + Ivl (Some l) (Some h) \ {l..h} | + Ivl (Some l) None \ {l..} | + Ivl None (Some h) \ {..h} | + Ivl None None \ UNIV)" -abbreviation I_Some_Some :: "int \ int \ ivl" ("{_\_}") where -"{lo\hi} == I (Some lo) (Some hi)" -abbreviation I_Some_None :: "int \ ivl" ("{_\}") where -"{lo\} == I (Some lo) None" -abbreviation I_None_Some :: "int \ ivl" ("{\_}") where -"{\hi} == I None (Some hi)" -abbreviation I_None_None :: "ivl" ("{\}") where -"{\} == I None None" +abbreviation Ivl_Some_Some :: "int \ int \ ivl" ("{_\_}") where +"{lo\hi} == Ivl (Some lo) (Some hi)" +abbreviation Ivl_Some_None :: "int \ ivl" ("{_\}") where +"{lo\} == Ivl (Some lo) None" +abbreviation Ivl_None_Some :: "int \ ivl" ("{\_}") where +"{\hi} == Ivl None (Some hi)" +abbreviation Ivl_None_None :: "ivl" ("{\}") where +"{\} == Ivl None None" definition "num_ivl n = {n\n}" fun in_ivl :: "int \ ivl \ bool" where -"in_ivl k (I (Some l) (Some h)) \ l \ k \ k \ h" | -"in_ivl k (I (Some l) None) \ l \ k" | -"in_ivl k (I None (Some h)) \ k \ h" | -"in_ivl k (I None None) \ True" +"in_ivl k (Ivl (Some l) (Some h)) \ l \ k \ k \ h" | +"in_ivl k (Ivl (Some l) None) \ l \ k" | +"in_ivl k (Ivl None (Some h)) \ k \ h" | +"in_ivl k (Ivl None None) \ True" instantiation option :: (plus)plus begin @@ -48,7 +48,7 @@ "is_empty {l\h} = (h (case h of Some h \ h False) | None \ False)" by(auto split:option.split) @@ -56,7 +56,7 @@ by(auto simp add: \_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))" + case (i1,i2) of (Ivl l1 h1, Ivl l2 h2) \ Ivl (l1+l2) (h1+h2))" instantiation ivl :: semilattice begin @@ -67,7 +67,7 @@ | 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)" +"le_aux (Ivl l1 h1) (Ivl l2 h2) = (le_option False l2 l1 & le_option True h1 h2)" definition le_ivl where "i1 \ i2 = @@ -82,8 +82,8 @@ 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))" + else case (i1,i2) of (Ivl l1 h1, Ivl l2 h2) \ + Ivl (min_option False l1 l2) (max_option True h1 h2))" definition "\ = {\}" @@ -115,8 +115,8 @@ 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))" + case (i1,i2) of (Ivl l1 h1, Ivl l2 h2) \ + Ivl (max_option False l1 l2) (min_option True h1 h2))" definition "\ = empty" @@ -148,7 +148,7 @@ 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))" + case (i1,i2) of (Ivl l1 h1, Ivl l2 h2) \ Ivl (l1-h2) (h1-l2))" lemma gamma_minus_ivl: "n1 : \_ivl i1 \ n2 : \_ivl i2 \ n1-n2 : \_ivl(minus_ivl i1 i2)" @@ -158,12 +158,12 @@ 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 +"filter_less_ivl res (Ivl l1 h1) (Ivl l2 h2) = + (if is_empty(Ivl l1 h1) \ is_empty(Ivl 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)))" + then (Ivl l1 (min_option True h1 (h2 - Some 1)), + Ivl (max_option False (l1 + Some 1) l2) h2) + else (Ivl (max_option False l1 l2) h1, Ivl l2 (min_option True h1 h2)))" interpretation Val_abs where \ = \_ivl and num' = num_ivl and plus' = plus_ivl diff -r 10f9f8608b4d -r 1c73b107d20d src/HOL/IMP/Abs_Int3.thy --- a/src/HOL/IMP/Abs_Int3.thy Wed Sep 26 03:03:11 2012 +0200 +++ b/src/HOL/IMP/Abs_Int3.thy Wed Sep 26 03:16:40 2012 +0200 @@ -86,15 +86,15 @@ 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))" + case (ivl1,ivl2) of (Ivl l1 h1, Ivl l2 h2) \ + Ivl (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))" + case (ivl1,ivl2) of (Ivl l1 h1, Ivl l2 h2) \ + Ivl (if l1 = None then l2 else l1) + (if h1 = None then h2 else h1))" instance proof qed @@ -583,7 +583,7 @@ subsubsection "Termination: Intervals" definition m_ivl :: "ivl \ nat" where -"m_ivl ivl = (case ivl of I l h \ +"m_ivl ivl = (case ivl of Ivl l h \ (case l of None \ 0 | Some _ \ 1) + (case h of None \ 0 | Some _ \ 1))" lemma m_ivl_height: "m_ivl ivl \ 2"