src/HOL/HOLCF/ConvexPD.thy
author wenzelm
Mon, 19 Jan 2015 20:39:01 +0100
changeset 59409 b7cfe12acf2e
parent 58880 0baae4311a9f
child 61169 4de9ff3ea29a
permissions -rw-r--r--
tuned;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
42151
4da4fc77664b tuned headers;
wenzelm
parents: 41479
diff changeset
     1
(*  Title:      HOL/HOLCF/ConvexPD.thy
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
     2
    Author:     Brian Huffman
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
     3
*)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
     4
58880
0baae4311a9f modernized header;
wenzelm
parents: 51489
diff changeset
     5
section {* Convex powerdomain *}
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
     6
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
     7
theory ConvexPD
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
     8
imports UpperPD LowerPD
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
     9
begin
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    10
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    11
subsection {* Basis preorder *}
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    12
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    13
definition
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    14
  convex_le :: "'a pd_basis \<Rightarrow> 'a pd_basis \<Rightarrow> bool" (infix "\<le>\<natural>" 50) where
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    15
  "convex_le = (\<lambda>u v. u \<le>\<sharp> v \<and> u \<le>\<flat> v)"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    16
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    17
lemma convex_le_refl [simp]: "t \<le>\<natural> t"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    18
unfolding convex_le_def by (fast intro: upper_le_refl lower_le_refl)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    19
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    20
lemma convex_le_trans: "\<lbrakk>t \<le>\<natural> u; u \<le>\<natural> v\<rbrakk> \<Longrightarrow> t \<le>\<natural> v"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    21
unfolding convex_le_def by (fast intro: upper_le_trans lower_le_trans)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    22
30729
461ee3e49ad3 interpretation/interpret: prefixes are mandatory by default;
wenzelm
parents: 29990
diff changeset
    23
interpretation convex_le: preorder convex_le
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    24
by (rule preorder.intro, rule convex_le_refl, rule convex_le_trans)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    25
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    26
lemma upper_le_minimal [simp]: "PDUnit compact_bot \<le>\<natural> t"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    27
unfolding convex_le_def Rep_PDUnit by simp
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    28
26420
57a626f64875 make preorder locale into a superclass of class po
huffman
parents: 26407
diff changeset
    29
lemma PDUnit_convex_mono: "x \<sqsubseteq> y \<Longrightarrow> PDUnit x \<le>\<natural> PDUnit y"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    30
unfolding convex_le_def by (fast intro: PDUnit_upper_mono PDUnit_lower_mono)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    31
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    32
lemma PDPlus_convex_mono: "\<lbrakk>s \<le>\<natural> t; u \<le>\<natural> v\<rbrakk> \<Longrightarrow> PDPlus s u \<le>\<natural> PDPlus t v"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    33
unfolding convex_le_def by (fast intro: PDPlus_upper_mono PDPlus_lower_mono)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    34
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    35
lemma convex_le_PDUnit_PDUnit_iff [simp]:
40436
adb22dbb5242 (infixl "<<" 55) -> (infix "<<" 50)
huffman
parents: 40433
diff changeset
    36
  "(PDUnit a \<le>\<natural> PDUnit b) = (a \<sqsubseteq> b)"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    37
unfolding convex_le_def upper_le_def lower_le_def Rep_PDUnit by fast
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    38
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    39
lemma convex_le_PDUnit_lemma1:
26420
57a626f64875 make preorder locale into a superclass of class po
huffman
parents: 26407
diff changeset
    40
  "(PDUnit a \<le>\<natural> t) = (\<forall>b\<in>Rep_pd_basis t. a \<sqsubseteq> b)"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    41
unfolding convex_le_def upper_le_def lower_le_def Rep_PDUnit
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    42
using Rep_pd_basis_nonempty [of t, folded ex_in_conv] by fast
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    43
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    44
lemma convex_le_PDUnit_PDPlus_iff [simp]:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    45
  "(PDUnit a \<le>\<natural> PDPlus t u) = (PDUnit a \<le>\<natural> t \<and> PDUnit a \<le>\<natural> u)"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    46
unfolding convex_le_PDUnit_lemma1 Rep_PDPlus by fast
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    47
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    48
lemma convex_le_PDUnit_lemma2:
26420
57a626f64875 make preorder locale into a superclass of class po
huffman
parents: 26407
diff changeset
    49
  "(t \<le>\<natural> PDUnit b) = (\<forall>a\<in>Rep_pd_basis t. a \<sqsubseteq> b)"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    50
unfolding convex_le_def upper_le_def lower_le_def Rep_PDUnit
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    51
using Rep_pd_basis_nonempty [of t, folded ex_in_conv] by fast
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    52
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    53
lemma convex_le_PDPlus_PDUnit_iff [simp]:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    54
  "(PDPlus t u \<le>\<natural> PDUnit a) = (t \<le>\<natural> PDUnit a \<and> u \<le>\<natural> PDUnit a)"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    55
unfolding convex_le_PDUnit_lemma2 Rep_PDPlus by fast
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    56
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    57
lemma convex_le_PDPlus_lemma:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    58
  assumes z: "PDPlus t u \<le>\<natural> z"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    59
  shows "\<exists>v w. z = PDPlus v w \<and> t \<le>\<natural> v \<and> u \<le>\<natural> w"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    60
proof (intro exI conjI)
26420
57a626f64875 make preorder locale into a superclass of class po
huffman
parents: 26407
diff changeset
    61
  let ?A = "{b\<in>Rep_pd_basis z. \<exists>a\<in>Rep_pd_basis t. a \<sqsubseteq> b}"
57a626f64875 make preorder locale into a superclass of class po
huffman
parents: 26407
diff changeset
    62
  let ?B = "{b\<in>Rep_pd_basis z. \<exists>a\<in>Rep_pd_basis u. a \<sqsubseteq> b}"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    63
  let ?v = "Abs_pd_basis ?A"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    64
  let ?w = "Abs_pd_basis ?B"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    65
  have Rep_v: "Rep_pd_basis ?v = ?A"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    66
    apply (rule Abs_pd_basis_inverse)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    67
    apply (rule Rep_pd_basis_nonempty [of t, folded ex_in_conv, THEN exE])
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    68
    apply (cut_tac z, simp only: convex_le_def lower_le_def, clarify)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    69
    apply (drule_tac x=x in bspec, simp add: Rep_PDPlus, erule bexE)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    70
    apply (simp add: pd_basis_def)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    71
    apply fast
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    72
    done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    73
  have Rep_w: "Rep_pd_basis ?w = ?B"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    74
    apply (rule Abs_pd_basis_inverse)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    75
    apply (rule Rep_pd_basis_nonempty [of u, folded ex_in_conv, THEN exE])
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    76
    apply (cut_tac z, simp only: convex_le_def lower_le_def, clarify)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    77
    apply (drule_tac x=x in bspec, simp add: Rep_PDPlus, erule bexE)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    78
    apply (simp add: pd_basis_def)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    79
    apply fast
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    80
    done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    81
  show "z = PDPlus ?v ?w"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    82
    apply (insert z)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    83
    apply (simp add: convex_le_def, erule conjE)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    84
    apply (simp add: Rep_pd_basis_inject [symmetric] Rep_PDPlus)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    85
    apply (simp add: Rep_v Rep_w)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    86
    apply (rule equalityI)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    87
     apply (rule subsetI)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    88
     apply (simp only: upper_le_def)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    89
     apply (drule (1) bspec, erule bexE)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    90
     apply (simp add: Rep_PDPlus)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    91
     apply fast
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    92
    apply fast
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    93
    done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    94
  show "t \<le>\<natural> ?v" "u \<le>\<natural> ?w"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    95
   apply (insert z)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    96
   apply (simp_all add: convex_le_def upper_le_def lower_le_def Rep_PDPlus Rep_v Rep_w)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    97
   apply fast+
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    98
   done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
    99
qed
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   100
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   101
lemma convex_le_induct [induct set: convex_le]:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   102
  assumes le: "t \<le>\<natural> u"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   103
  assumes 2: "\<And>t u v. \<lbrakk>P t u; P u v\<rbrakk> \<Longrightarrow> P t v"
26420
57a626f64875 make preorder locale into a superclass of class po
huffman
parents: 26407
diff changeset
   104
  assumes 3: "\<And>a b. a \<sqsubseteq> b \<Longrightarrow> P (PDUnit a) (PDUnit b)"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   105
  assumes 4: "\<And>t u v w. \<lbrakk>P t v; P u w\<rbrakk> \<Longrightarrow> P (PDPlus t u) (PDPlus v w)"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   106
  shows "P t u"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   107
using le apply (induct t arbitrary: u rule: pd_basis_induct)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   108
apply (erule rev_mp)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   109
apply (induct_tac u rule: pd_basis_induct1)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   110
apply (simp add: 3)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   111
apply (simp, clarify, rename_tac a b t)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   112
apply (subgoal_tac "P (PDPlus (PDUnit a) (PDUnit a)) (PDPlus (PDUnit b) t)")
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   113
apply (simp add: PDPlus_absorb)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   114
apply (erule (1) 4 [OF 3])
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   115
apply (drule convex_le_PDPlus_lemma, clarify)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   116
apply (simp add: 4)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   117
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   118
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   119
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   120
subsection {* Type definition *}
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   121
49834
b27bbb021df1 discontinued obsolete typedef (open) syntax;
wenzelm
parents: 45606
diff changeset
   122
typedef 'a convex_pd =
27373
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   123
  "{S::'a pd_basis set. convex_le.ideal S}"
40888
28cd51cff70c reformulate lemma preorder.ex_ideal, and use it for typedefs
huffman
parents: 40774
diff changeset
   124
by (rule convex_le.ex_ideal)
27373
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   125
41111
b497cc48e563 xsymbol notation for powerdomain types
huffman
parents: 41110
diff changeset
   126
type_notation (xsymbols) convex_pd ("('(_')\<natural>)")
b497cc48e563 xsymbol notation for powerdomain types
huffman
parents: 41110
diff changeset
   127
41288
a19edebad961 powerdomain theories require class 'bifinite' instead of 'domain'
huffman
parents: 41287
diff changeset
   128
instantiation convex_pd :: (bifinite) below
27373
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   129
begin
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   130
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   131
definition
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   132
  "x \<sqsubseteq> y \<longleftrightarrow> Rep_convex_pd x \<subseteq> Rep_convex_pd y"
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   133
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   134
instance ..
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   135
end
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   136
41288
a19edebad961 powerdomain theories require class 'bifinite' instead of 'domain'
huffman
parents: 41287
diff changeset
   137
instance convex_pd :: (bifinite) po
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   138
using type_definition_convex_pd below_convex_pd_def
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   139
by (rule convex_le.typedef_ideal_po)
27373
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   140
41288
a19edebad961 powerdomain theories require class 'bifinite' instead of 'domain'
huffman
parents: 41287
diff changeset
   141
instance convex_pd :: (bifinite) cpo
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   142
using type_definition_convex_pd below_convex_pd_def
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   143
by (rule convex_le.typedef_ideal_cpo)
27373
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   144
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   145
definition
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   146
  convex_principal :: "'a pd_basis \<Rightarrow> 'a convex_pd" where
27373
5794a0e3e26c remove cset theory; define ideal completions using typedef instead of cpodef
huffman
parents: 27310
diff changeset
   147
  "convex_principal t = Abs_convex_pd {u. u \<le>\<natural> t}"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   148
30729
461ee3e49ad3 interpretation/interpret: prefixes are mandatory by default;
wenzelm
parents: 29990
diff changeset
   149
interpretation convex_pd:
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   150
  ideal_completion convex_le convex_principal Rep_convex_pd
39984
0300d5170622 add lemma typedef_ideal_completion
huffman
parents: 39974
diff changeset
   151
using type_definition_convex_pd below_convex_pd_def
0300d5170622 add lemma typedef_ideal_completion
huffman
parents: 39974
diff changeset
   152
using convex_principal_def pd_basis_countable
0300d5170622 add lemma typedef_ideal_completion
huffman
parents: 39974
diff changeset
   153
by (rule convex_le.typedef_ideal_completion)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   154
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   155
text {* Convex powerdomain is pointed *}
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   156
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   157
lemma convex_pd_minimal: "convex_principal (PDUnit compact_bot) \<sqsubseteq> ys"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   158
by (induct ys rule: convex_pd.principal_induct, simp, simp)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   159
41288
a19edebad961 powerdomain theories require class 'bifinite' instead of 'domain'
huffman
parents: 41287
diff changeset
   160
instance convex_pd :: (bifinite) pcpo
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   161
by intro_classes (fast intro: convex_pd_minimal)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   162
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   163
lemma inst_convex_pd_pcpo: "\<bottom> = convex_principal (PDUnit compact_bot)"
41430
1aa23e9f2c87 change some lemma names containing 'UU' to 'bottom'
huffman
parents: 41402
diff changeset
   164
by (rule convex_pd_minimal [THEN bottomI, symmetric])
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   165
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   166
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   167
subsection {* Monadic unit and plus *}
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   168
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   169
definition
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   170
  convex_unit :: "'a \<rightarrow> 'a convex_pd" where
41394
51c866d1b53b rename function ideal_completion.basis_fun to ideal_completion.extension
huffman
parents: 41289
diff changeset
   171
  "convex_unit = compact_basis.extension (\<lambda>a. convex_principal (PDUnit a))"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   172
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   173
definition
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   174
  convex_plus :: "'a convex_pd \<rightarrow> 'a convex_pd \<rightarrow> 'a convex_pd" where
41394
51c866d1b53b rename function ideal_completion.basis_fun to ideal_completion.extension
huffman
parents: 41289
diff changeset
   175
  "convex_plus = convex_pd.extension (\<lambda>t. convex_pd.extension (\<lambda>u.
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   176
      convex_principal (PDPlus t u)))"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   177
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   178
abbreviation
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   179
  convex_add :: "'a convex_pd \<Rightarrow> 'a convex_pd \<Rightarrow> 'a convex_pd"
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   180
    (infixl "\<union>\<natural>" 65) where
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   181
  "xs \<union>\<natural> ys == convex_plus\<cdot>xs\<cdot>ys"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   182
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   183
syntax
41479
655f583840d0 use proper syntactic types for 'syntax' commands
huffman
parents: 41430
diff changeset
   184
  "_convex_pd" :: "args \<Rightarrow> logic" ("{_}\<natural>")
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   185
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   186
translations
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   187
  "{x,xs}\<natural>" == "{x}\<natural> \<union>\<natural> {xs}\<natural>"
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   188
  "{x}\<natural>" == "CONST convex_unit\<cdot>x"
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   189
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   190
lemma convex_unit_Rep_compact_basis [simp]:
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   191
  "{Rep_compact_basis a}\<natural> = convex_principal (PDUnit a)"
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   192
unfolding convex_unit_def
41394
51c866d1b53b rename function ideal_completion.basis_fun to ideal_completion.extension
huffman
parents: 41289
diff changeset
   193
by (simp add: compact_basis.extension_principal PDUnit_convex_mono)
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   194
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   195
lemma convex_plus_principal [simp]:
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   196
  "convex_principal t \<union>\<natural> convex_principal u = convex_principal (PDPlus t u)"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   197
unfolding convex_plus_def
41394
51c866d1b53b rename function ideal_completion.basis_fun to ideal_completion.extension
huffman
parents: 41289
diff changeset
   198
by (simp add: convex_pd.extension_principal
51c866d1b53b rename function ideal_completion.basis_fun to ideal_completion.extension
huffman
parents: 41289
diff changeset
   199
    convex_pd.extension_mono PDPlus_convex_mono)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   200
37770
cddb3106adb8 avoid explicit mandatory prefix markers when prefixes are mandatory implicitly
haftmann
parents: 36635
diff changeset
   201
interpretation convex_add: semilattice convex_add proof
34973
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   202
  fix xs ys zs :: "'a convex_pd"
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   203
  show "(xs \<union>\<natural> ys) \<union>\<natural> zs = xs \<union>\<natural> (ys \<union>\<natural> zs)"
41402
b647212cee03 remove lemma ideal_completion.principal_induct2, use principal_induct twice instead
huffman
parents: 41399
diff changeset
   204
    apply (induct xs rule: convex_pd.principal_induct, simp)
b647212cee03 remove lemma ideal_completion.principal_induct2, use principal_induct twice instead
huffman
parents: 41399
diff changeset
   205
    apply (induct ys rule: convex_pd.principal_induct, simp)
b647212cee03 remove lemma ideal_completion.principal_induct2, use principal_induct twice instead
huffman
parents: 41399
diff changeset
   206
    apply (induct zs rule: convex_pd.principal_induct, simp)
34973
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   207
    apply (simp add: PDPlus_assoc)
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   208
    done
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   209
  show "xs \<union>\<natural> ys = ys \<union>\<natural> xs"
41402
b647212cee03 remove lemma ideal_completion.principal_induct2, use principal_induct twice instead
huffman
parents: 41399
diff changeset
   210
    apply (induct xs rule: convex_pd.principal_induct, simp)
b647212cee03 remove lemma ideal_completion.principal_induct2, use principal_induct twice instead
huffman
parents: 41399
diff changeset
   211
    apply (induct ys rule: convex_pd.principal_induct, simp)
34973
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   212
    apply (simp add: PDPlus_commute)
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   213
    done
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   214
  show "xs \<union>\<natural> xs = xs"
34973
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   215
    apply (induct xs rule: convex_pd.principal_induct, simp)
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   216
    apply (simp add: PDPlus_absorb)
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   217
    done
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   218
qed
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   219
34973
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   220
lemmas convex_plus_assoc = convex_add.assoc
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   221
lemmas convex_plus_commute = convex_add.commute
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   222
lemmas convex_plus_absorb = convex_add.idem
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   223
lemmas convex_plus_left_commute = convex_add.left_commute
ae634fad947e dropped mk_left_commute; use interpretation of locale abel_semigroup instead
haftmann
parents: 33808
diff changeset
   224
lemmas convex_plus_left_absorb = convex_add.left_idem
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   225
29990
b11793ea15a3 avoid using ab_semigroup_idem_mult locale for powerdomains
huffman
parents: 29672
diff changeset
   226
text {* Useful for @{text "simp add: convex_plus_ac"} *}
b11793ea15a3 avoid using ab_semigroup_idem_mult locale for powerdomains
huffman
parents: 29672
diff changeset
   227
lemmas convex_plus_ac =
b11793ea15a3 avoid using ab_semigroup_idem_mult locale for powerdomains
huffman
parents: 29672
diff changeset
   228
  convex_plus_assoc convex_plus_commute convex_plus_left_commute
b11793ea15a3 avoid using ab_semigroup_idem_mult locale for powerdomains
huffman
parents: 29672
diff changeset
   229
b11793ea15a3 avoid using ab_semigroup_idem_mult locale for powerdomains
huffman
parents: 29672
diff changeset
   230
text {* Useful for @{text "simp only: convex_plus_aci"} *}
b11793ea15a3 avoid using ab_semigroup_idem_mult locale for powerdomains
huffman
parents: 29672
diff changeset
   231
lemmas convex_plus_aci =
b11793ea15a3 avoid using ab_semigroup_idem_mult locale for powerdomains
huffman
parents: 29672
diff changeset
   232
  convex_plus_ac convex_plus_absorb convex_plus_left_absorb
b11793ea15a3 avoid using ab_semigroup_idem_mult locale for powerdomains
huffman
parents: 29672
diff changeset
   233
31076
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   234
lemma convex_unit_below_plus_iff [simp]:
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   235
  "{x}\<natural> \<sqsubseteq> ys \<union>\<natural> zs \<longleftrightarrow> {x}\<natural> \<sqsubseteq> ys \<and> {x}\<natural> \<sqsubseteq> zs"
39970
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   236
apply (induct x rule: compact_basis.principal_induct, simp)
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   237
apply (induct ys rule: convex_pd.principal_induct, simp)
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   238
apply (induct zs rule: convex_pd.principal_induct, simp)
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   239
apply simp
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   240
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   241
31076
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   242
lemma convex_plus_below_unit_iff [simp]:
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   243
  "xs \<union>\<natural> ys \<sqsubseteq> {z}\<natural> \<longleftrightarrow> xs \<sqsubseteq> {z}\<natural> \<and> ys \<sqsubseteq> {z}\<natural>"
39970
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   244
apply (induct xs rule: convex_pd.principal_induct, simp)
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   245
apply (induct ys rule: convex_pd.principal_induct, simp)
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   246
apply (induct z rule: compact_basis.principal_induct, simp)
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   247
apply simp
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   248
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   249
31076
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   250
lemma convex_unit_below_iff [simp]: "{x}\<natural> \<sqsubseteq> {y}\<natural> \<longleftrightarrow> x \<sqsubseteq> y"
39970
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   251
apply (induct x rule: compact_basis.principal_induct, simp)
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   252
apply (induct y rule: compact_basis.principal_induct, simp)
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   253
apply simp
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   254
done
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   255
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   256
lemma convex_unit_eq_iff [simp]: "{x}\<natural> = {y}\<natural> \<longleftrightarrow> x = y"
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   257
unfolding po_eq_conv by simp
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   258
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   259
lemma convex_unit_strict [simp]: "{\<bottom>}\<natural> = \<bottom>"
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   260
using convex_unit_Rep_compact_basis [of compact_bot]
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   261
by (simp add: inst_convex_pd_pcpo)
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   262
40321
d065b195ec89 rename lemmas *_defined_iff and *_strict_iff to *_bottom_iff
huffman
parents: 40002
diff changeset
   263
lemma convex_unit_bottom_iff [simp]: "{x}\<natural> = \<bottom> \<longleftrightarrow> x = \<bottom>"
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   264
unfolding convex_unit_strict [symmetric] by (rule convex_unit_eq_iff)
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   265
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   266
lemma compact_convex_unit: "compact x \<Longrightarrow> compact {x}\<natural>"
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   267
by (auto dest!: compact_basis.compact_imp_principal)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   268
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   269
lemma compact_convex_unit_iff [simp]: "compact {x}\<natural> \<longleftrightarrow> compact x"
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   270
apply (safe elim!: compact_convex_unit)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   271
apply (simp only: compact_def convex_unit_below_iff [symmetric])
40327
1dfdbd66093a renamed {Rep,Abs}_CFun to {Rep,Abs}_cfun
huffman
parents: 40321
diff changeset
   272
apply (erule adm_subst [OF cont_Rep_cfun2])
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   273
done
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   274
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   275
lemma compact_convex_plus [simp]:
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   276
  "\<lbrakk>compact xs; compact ys\<rbrakk> \<Longrightarrow> compact (xs \<union>\<natural> ys)"
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   277
by (auto dest!: convex_pd.compact_imp_principal)
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   278
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   279
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   280
subsection {* Induction rules *}
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   281
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   282
lemma convex_pd_induct1:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   283
  assumes P: "adm P"
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   284
  assumes unit: "\<And>x. P {x}\<natural>"
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   285
  assumes insert: "\<And>x ys. \<lbrakk>P {x}\<natural>; P ys\<rbrakk> \<Longrightarrow> P ({x}\<natural> \<union>\<natural> ys)"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   286
  shows "P (xs::'a convex_pd)"
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   287
apply (induct xs rule: convex_pd.principal_induct, rule P)
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   288
apply (induct_tac a rule: pd_basis_induct1)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   289
apply (simp only: convex_unit_Rep_compact_basis [symmetric])
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   290
apply (rule unit)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   291
apply (simp only: convex_unit_Rep_compact_basis [symmetric]
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   292
                  convex_plus_principal [symmetric])
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   293
apply (erule insert [OF unit])
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   294
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   295
40576
fa5e0cacd5e7 declare {upper,lower,convex}_pd_induct as default induction rules
huffman
parents: 40497
diff changeset
   296
lemma convex_pd_induct
fa5e0cacd5e7 declare {upper,lower,convex}_pd_induct as default induction rules
huffman
parents: 40497
diff changeset
   297
  [case_names adm convex_unit convex_plus, induct type: convex_pd]:
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   298
  assumes P: "adm P"
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   299
  assumes unit: "\<And>x. P {x}\<natural>"
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   300
  assumes plus: "\<And>xs ys. \<lbrakk>P xs; P ys\<rbrakk> \<Longrightarrow> P (xs \<union>\<natural> ys)"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   301
  shows "P (xs::'a convex_pd)"
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   302
apply (induct xs rule: convex_pd.principal_induct, rule P)
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   303
apply (induct_tac a rule: pd_basis_induct)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   304
apply (simp only: convex_unit_Rep_compact_basis [symmetric] unit)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   305
apply (simp only: convex_plus_principal [symmetric] plus)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   306
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   307
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   308
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   309
subsection {* Monadic bind *}
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   310
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   311
definition
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   312
  convex_bind_basis ::
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   313
  "'a pd_basis \<Rightarrow> ('a \<rightarrow> 'b convex_pd) \<rightarrow> 'b convex_pd" where
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   314
  "convex_bind_basis = fold_pd
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   315
    (\<lambda>a. \<Lambda> f. f\<cdot>(Rep_compact_basis a))
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   316
    (\<lambda>x y. \<Lambda> f. x\<cdot>f \<union>\<natural> y\<cdot>f)"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   317
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   318
lemma ACI_convex_bind:
51489
f738e6dbd844 fundamental revision of big operators on sets
haftmann
parents: 49834
diff changeset
   319
  "semilattice (\<lambda>x y. \<Lambda> f. x\<cdot>f \<union>\<natural> y\<cdot>f)"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   320
apply unfold_locales
26041
c2e15e65165f locales ACf, ACIf, ACIfSL and ACIfSLlin have been abandoned in favour of the existing algebraic classes ab_semigroup_mult, ab_semigroup_idem_mult, lower_semilattice (resp. uper_semilattice) and linorder
haftmann
parents: 25925
diff changeset
   321
apply (simp add: convex_plus_assoc)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   322
apply (simp add: convex_plus_commute)
29990
b11793ea15a3 avoid using ab_semigroup_idem_mult locale for powerdomains
huffman
parents: 29672
diff changeset
   323
apply (simp add: eta_cfun)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   324
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   325
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   326
lemma convex_bind_basis_simps [simp]:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   327
  "convex_bind_basis (PDUnit a) =
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   328
    (\<Lambda> f. f\<cdot>(Rep_compact_basis a))"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   329
  "convex_bind_basis (PDPlus t u) =
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   330
    (\<Lambda> f. convex_bind_basis t\<cdot>f \<union>\<natural> convex_bind_basis u\<cdot>f)"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   331
unfolding convex_bind_basis_def
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   332
apply -
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   333
apply (rule fold_pd_PDUnit [OF ACI_convex_bind])
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   334
apply (rule fold_pd_PDPlus [OF ACI_convex_bind])
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   335
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   336
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   337
lemma convex_bind_basis_mono:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   338
  "t \<le>\<natural> u \<Longrightarrow> convex_bind_basis t \<sqsubseteq> convex_bind_basis u"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   339
apply (erule convex_le_induct)
31076
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   340
apply (erule (1) below_trans)
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   341
apply (simp add: monofun_LAM monofun_cfun)
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   342
apply (simp add: monofun_LAM monofun_cfun)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   343
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   344
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   345
definition
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   346
  convex_bind :: "'a convex_pd \<rightarrow> ('a \<rightarrow> 'b convex_pd) \<rightarrow> 'b convex_pd" where
41394
51c866d1b53b rename function ideal_completion.basis_fun to ideal_completion.extension
huffman
parents: 41289
diff changeset
   347
  "convex_bind = convex_pd.extension convex_bind_basis"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   348
41036
4acbacd6c5bc add set-union-like syntax for powerdomain bind operators
huffman
parents: 40888
diff changeset
   349
syntax
4acbacd6c5bc add set-union-like syntax for powerdomain bind operators
huffman
parents: 40888
diff changeset
   350
  "_convex_bind" :: "[logic, logic, logic] \<Rightarrow> logic"
4acbacd6c5bc add set-union-like syntax for powerdomain bind operators
huffman
parents: 40888
diff changeset
   351
    ("(3\<Union>\<natural>_\<in>_./ _)" [0, 0, 10] 10)
4acbacd6c5bc add set-union-like syntax for powerdomain bind operators
huffman
parents: 40888
diff changeset
   352
4acbacd6c5bc add set-union-like syntax for powerdomain bind operators
huffman
parents: 40888
diff changeset
   353
translations
4acbacd6c5bc add set-union-like syntax for powerdomain bind operators
huffman
parents: 40888
diff changeset
   354
  "\<Union>\<natural>x\<in>xs. e" == "CONST convex_bind\<cdot>xs\<cdot>(\<Lambda> x. e)"
4acbacd6c5bc add set-union-like syntax for powerdomain bind operators
huffman
parents: 40888
diff changeset
   355
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   356
lemma convex_bind_principal [simp]:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   357
  "convex_bind\<cdot>(convex_principal t) = convex_bind_basis t"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   358
unfolding convex_bind_def
41394
51c866d1b53b rename function ideal_completion.basis_fun to ideal_completion.extension
huffman
parents: 41289
diff changeset
   359
apply (rule convex_pd.extension_principal)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   360
apply (erule convex_bind_basis_mono)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   361
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   362
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   363
lemma convex_bind_unit [simp]:
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   364
  "convex_bind\<cdot>{x}\<natural>\<cdot>f = f\<cdot>x"
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   365
by (induct x rule: compact_basis.principal_induct, simp, simp)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   366
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   367
lemma convex_bind_plus [simp]:
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   368
  "convex_bind\<cdot>(xs \<union>\<natural> ys)\<cdot>f = convex_bind\<cdot>xs\<cdot>f \<union>\<natural> convex_bind\<cdot>ys\<cdot>f"
41402
b647212cee03 remove lemma ideal_completion.principal_induct2, use principal_induct twice instead
huffman
parents: 41399
diff changeset
   369
by (induct xs rule: convex_pd.principal_induct, simp,
b647212cee03 remove lemma ideal_completion.principal_induct2, use principal_induct twice instead
huffman
parents: 41399
diff changeset
   370
    induct ys rule: convex_pd.principal_induct, simp, simp)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   371
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   372
lemma convex_bind_strict [simp]: "convex_bind\<cdot>\<bottom>\<cdot>f = f\<cdot>\<bottom>"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   373
unfolding convex_unit_strict [symmetric] by (rule convex_bind_unit)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   374
40589
0e77e45d2ffc add bind_bind rules for powerdomains
huffman
parents: 40577
diff changeset
   375
lemma convex_bind_bind:
0e77e45d2ffc add bind_bind rules for powerdomains
huffman
parents: 40577
diff changeset
   376
  "convex_bind\<cdot>(convex_bind\<cdot>xs\<cdot>f)\<cdot>g =
0e77e45d2ffc add bind_bind rules for powerdomains
huffman
parents: 40577
diff changeset
   377
    convex_bind\<cdot>xs\<cdot>(\<Lambda> x. convex_bind\<cdot>(f\<cdot>x)\<cdot>g)"
0e77e45d2ffc add bind_bind rules for powerdomains
huffman
parents: 40577
diff changeset
   378
by (induct xs, simp_all)
0e77e45d2ffc add bind_bind rules for powerdomains
huffman
parents: 40577
diff changeset
   379
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   380
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   381
subsection {* Map *}
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   382
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   383
definition
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   384
  convex_map :: "('a \<rightarrow> 'b) \<rightarrow> 'a convex_pd \<rightarrow> 'b convex_pd" where
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   385
  "convex_map = (\<Lambda> f xs. convex_bind\<cdot>xs\<cdot>(\<Lambda> x. {f\<cdot>x}\<natural>))"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   386
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   387
lemma convex_map_unit [simp]:
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   388
  "convex_map\<cdot>f\<cdot>{x}\<natural> = {f\<cdot>x}\<natural>"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   389
unfolding convex_map_def by simp
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   390
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   391
lemma convex_map_plus [simp]:
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   392
  "convex_map\<cdot>f\<cdot>(xs \<union>\<natural> ys) = convex_map\<cdot>f\<cdot>xs \<union>\<natural> convex_map\<cdot>f\<cdot>ys"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   393
unfolding convex_map_def by simp
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   394
40577
5c6225a1c2c0 add lemmas about powerdomains
huffman
parents: 40576
diff changeset
   395
lemma convex_map_bottom [simp]: "convex_map\<cdot>f\<cdot>\<bottom> = {f\<cdot>\<bottom>}\<natural>"
5c6225a1c2c0 add lemmas about powerdomains
huffman
parents: 40576
diff changeset
   396
unfolding convex_map_def by simp
5c6225a1c2c0 add lemmas about powerdomains
huffman
parents: 40576
diff changeset
   397
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   398
lemma convex_map_ident: "convex_map\<cdot>(\<Lambda> x. x)\<cdot>xs = xs"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   399
by (induct xs rule: convex_pd_induct, simp_all)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   400
33808
31169fdc5ae7 add map_ID lemmas
huffman
parents: 33585
diff changeset
   401
lemma convex_map_ID: "convex_map\<cdot>ID = ID"
40002
c5b5f7a3a3b1 new theorem names: fun_below_iff, fun_belowI, cfun_eq_iff, cfun_eqI, cfun_below_iff, cfun_belowI
huffman
parents: 39989
diff changeset
   402
by (simp add: cfun_eq_iff ID_def convex_map_ident)
33808
31169fdc5ae7 add map_ID lemmas
huffman
parents: 33585
diff changeset
   403
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   404
lemma convex_map_map:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   405
  "convex_map\<cdot>f\<cdot>(convex_map\<cdot>g\<cdot>xs) = convex_map\<cdot>(\<Lambda> x. f\<cdot>(g\<cdot>x))\<cdot>xs"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   406
by (induct xs rule: convex_pd_induct, simp_all)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   407
41110
32099ee71a2f new powerdomain lemmas
huffman
parents: 41036
diff changeset
   408
lemma convex_bind_map:
32099ee71a2f new powerdomain lemmas
huffman
parents: 41036
diff changeset
   409
  "convex_bind\<cdot>(convex_map\<cdot>f\<cdot>xs)\<cdot>g = convex_bind\<cdot>xs\<cdot>(\<Lambda> x. g\<cdot>(f\<cdot>x))"
32099ee71a2f new powerdomain lemmas
huffman
parents: 41036
diff changeset
   410
by (simp add: convex_map_def convex_bind_bind)
32099ee71a2f new powerdomain lemmas
huffman
parents: 41036
diff changeset
   411
32099ee71a2f new powerdomain lemmas
huffman
parents: 41036
diff changeset
   412
lemma convex_map_bind:
32099ee71a2f new powerdomain lemmas
huffman
parents: 41036
diff changeset
   413
  "convex_map\<cdot>f\<cdot>(convex_bind\<cdot>xs\<cdot>g) = convex_bind\<cdot>xs\<cdot>(\<Lambda> x. convex_map\<cdot>f\<cdot>(g\<cdot>x))"
32099ee71a2f new powerdomain lemmas
huffman
parents: 41036
diff changeset
   414
by (simp add: convex_map_def convex_bind_bind)
32099ee71a2f new powerdomain lemmas
huffman
parents: 41036
diff changeset
   415
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   416
lemma ep_pair_convex_map: "ep_pair e p \<Longrightarrow> ep_pair (convex_map\<cdot>e) (convex_map\<cdot>p)"
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   417
apply default
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   418
apply (induct_tac x rule: convex_pd_induct, simp_all add: ep_pair.e_inverse)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   419
apply (induct_tac y rule: convex_pd_induct)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   420
apply (simp_all add: ep_pair.e_p_below monofun_cfun)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   421
done
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   422
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   423
lemma deflation_convex_map: "deflation d \<Longrightarrow> deflation (convex_map\<cdot>d)"
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   424
apply default
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   425
apply (induct_tac x rule: convex_pd_induct, simp_all add: deflation.idem)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   426
apply (induct_tac x rule: convex_pd_induct)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   427
apply (simp_all add: deflation.below monofun_cfun)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   428
done
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   429
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   430
(* FIXME: long proof! *)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   431
lemma finite_deflation_convex_map:
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   432
  assumes "finite_deflation d" shows "finite_deflation (convex_map\<cdot>d)"
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   433
proof (rule finite_deflation_intro)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   434
  interpret d: finite_deflation d by fact
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   435
  have "deflation d" by fact
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   436
  thus "deflation (convex_map\<cdot>d)" by (rule deflation_convex_map)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   437
  have "finite (range (\<lambda>x. d\<cdot>x))" by (rule d.finite_range)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   438
  hence "finite (Rep_compact_basis -` range (\<lambda>x. d\<cdot>x))"
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   439
    by (rule finite_vimageI, simp add: inj_on_def Rep_compact_basis_inject)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   440
  hence "finite (Pow (Rep_compact_basis -` range (\<lambda>x. d\<cdot>x)))" by simp
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   441
  hence "finite (Rep_pd_basis -` (Pow (Rep_compact_basis -` range (\<lambda>x. d\<cdot>x))))"
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   442
    by (rule finite_vimageI, simp add: inj_on_def Rep_pd_basis_inject)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   443
  hence *: "finite (convex_principal ` Rep_pd_basis -` (Pow (Rep_compact_basis -` range (\<lambda>x. d\<cdot>x))))" by simp
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   444
  hence "finite (range (\<lambda>xs. convex_map\<cdot>d\<cdot>xs))"
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   445
    apply (rule rev_finite_subset)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   446
    apply clarsimp
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   447
    apply (induct_tac xs rule: convex_pd.principal_induct)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   448
    apply (simp add: adm_mem_finite *)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   449
    apply (rename_tac t, induct_tac t rule: pd_basis_induct)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   450
    apply (simp only: convex_unit_Rep_compact_basis [symmetric] convex_map_unit)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   451
    apply simp
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   452
    apply (subgoal_tac "\<exists>b. d\<cdot>(Rep_compact_basis a) = Rep_compact_basis b")
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   453
    apply clarsimp
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   454
    apply (rule imageI)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   455
    apply (rule vimageI2)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   456
    apply (simp add: Rep_PDUnit)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   457
    apply (rule range_eqI)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   458
    apply (erule sym)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   459
    apply (rule exI)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   460
    apply (rule Abs_compact_basis_inverse [symmetric])
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   461
    apply (simp add: d.compact)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   462
    apply (simp only: convex_plus_principal [symmetric] convex_map_plus)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   463
    apply clarsimp
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   464
    apply (rule imageI)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   465
    apply (rule vimageI2)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   466
    apply (simp add: Rep_PDPlus)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   467
    done
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   468
  thus "finite {xs. convex_map\<cdot>d\<cdot>xs = xs}"
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   469
    by (rule finite_range_imp_finite_fixes)
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   470
qed
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   471
41289
f655912ac235 minimize imports; move domain class instances for powerdomain types into Powerdomains.thy
huffman
parents: 41288
diff changeset
   472
subsection {* Convex powerdomain is bifinite *}
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   473
41286
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   474
lemma approx_chain_convex_map:
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   475
  assumes "approx_chain a"
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   476
  shows "approx_chain (\<lambda>i. convex_map\<cdot>(a i))"
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   477
  using assms unfolding approx_chain_def
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   478
  by (simp add: lub_APP convex_map_ID finite_deflation_convex_map)
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   479
41288
a19edebad961 powerdomain theories require class 'bifinite' instead of 'domain'
huffman
parents: 41287
diff changeset
   480
instance convex_pd :: (bifinite) bifinite
41286
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   481
proof
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   482
  show "\<exists>(a::nat \<Rightarrow> 'a convex_pd \<rightarrow> 'a convex_pd). approx_chain a"
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   483
    using bifinite [where 'a='a]
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   484
    by (fast intro!: approx_chain_convex_map)
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   485
qed
3d7685a4a5ff reintroduce 'bifinite' class, now with existentially-quantified approx function (cf. b525988432e9)
huffman
parents: 41111
diff changeset
   486
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   487
subsection {* Join *}
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   488
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   489
definition
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   490
  convex_join :: "'a convex_pd convex_pd \<rightarrow> 'a convex_pd" where
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   491
  "convex_join = (\<Lambda> xss. convex_bind\<cdot>xss\<cdot>(\<Lambda> xs. xs))"
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   492
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   493
lemma convex_join_unit [simp]:
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   494
  "convex_join\<cdot>{xs}\<natural> = xs"
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   495
unfolding convex_join_def by simp
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   496
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   497
lemma convex_join_plus [simp]:
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   498
  "convex_join\<cdot>(xss \<union>\<natural> yss) = convex_join\<cdot>xss \<union>\<natural> convex_join\<cdot>yss"
39974
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   499
unfolding convex_join_def by simp
b525988432e9 major reorganization/simplification of HOLCF type classes:
huffman
parents: 39970
diff changeset
   500
40577
5c6225a1c2c0 add lemmas about powerdomains
huffman
parents: 40576
diff changeset
   501
lemma convex_join_bottom [simp]: "convex_join\<cdot>\<bottom> = \<bottom>"
5c6225a1c2c0 add lemmas about powerdomains
huffman
parents: 40576
diff changeset
   502
unfolding convex_join_def by simp
5c6225a1c2c0 add lemmas about powerdomains
huffman
parents: 40576
diff changeset
   503
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   504
lemma convex_join_map_unit:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   505
  "convex_join\<cdot>(convex_map\<cdot>convex_unit\<cdot>xs) = xs"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   506
by (induct xs rule: convex_pd_induct, simp_all)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   507
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   508
lemma convex_join_map_join:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   509
  "convex_join\<cdot>(convex_map\<cdot>convex_join\<cdot>xsss) = convex_join\<cdot>(convex_join\<cdot>xsss)"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   510
by (induct xsss rule: convex_pd_induct, simp_all)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   511
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   512
lemma convex_join_map_map:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   513
  "convex_join\<cdot>(convex_map\<cdot>(convex_map\<cdot>f)\<cdot>xss) =
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   514
   convex_map\<cdot>f\<cdot>(convex_join\<cdot>xss)"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   515
by (induct xss rule: convex_pd_induct, simp_all)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   516
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   517
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   518
subsection {* Conversions to other powerdomains *}
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   519
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   520
text {* Convex to upper *}
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   521
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   522
lemma convex_le_imp_upper_le: "t \<le>\<natural> u \<Longrightarrow> t \<le>\<sharp> u"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   523
unfolding convex_le_def by simp
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   524
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   525
definition
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   526
  convex_to_upper :: "'a convex_pd \<rightarrow> 'a upper_pd" where
41394
51c866d1b53b rename function ideal_completion.basis_fun to ideal_completion.extension
huffman
parents: 41289
diff changeset
   527
  "convex_to_upper = convex_pd.extension upper_principal"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   528
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   529
lemma convex_to_upper_principal [simp]:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   530
  "convex_to_upper\<cdot>(convex_principal t) = upper_principal t"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   531
unfolding convex_to_upper_def
41394
51c866d1b53b rename function ideal_completion.basis_fun to ideal_completion.extension
huffman
parents: 41289
diff changeset
   532
apply (rule convex_pd.extension_principal)
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   533
apply (rule upper_pd.principal_mono)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   534
apply (erule convex_le_imp_upper_le)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   535
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   536
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   537
lemma convex_to_upper_unit [simp]:
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   538
  "convex_to_upper\<cdot>{x}\<natural> = {x}\<sharp>"
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   539
by (induct x rule: compact_basis.principal_induct, simp, simp)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   540
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   541
lemma convex_to_upper_plus [simp]:
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   542
  "convex_to_upper\<cdot>(xs \<union>\<natural> ys) = convex_to_upper\<cdot>xs \<union>\<sharp> convex_to_upper\<cdot>ys"
41402
b647212cee03 remove lemma ideal_completion.principal_induct2, use principal_induct twice instead
huffman
parents: 41399
diff changeset
   543
by (induct xs rule: convex_pd.principal_induct, simp,
b647212cee03 remove lemma ideal_completion.principal_induct2, use principal_induct twice instead
huffman
parents: 41399
diff changeset
   544
    induct ys rule: convex_pd.principal_induct, simp, simp)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   545
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   546
lemma convex_to_upper_bind [simp]:
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   547
  "convex_to_upper\<cdot>(convex_bind\<cdot>xs\<cdot>f) =
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   548
    upper_bind\<cdot>(convex_to_upper\<cdot>xs)\<cdot>(convex_to_upper oo f)"
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   549
by (induct xs rule: convex_pd_induct, simp, simp, simp)
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   550
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   551
lemma convex_to_upper_map [simp]:
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   552
  "convex_to_upper\<cdot>(convex_map\<cdot>f\<cdot>xs) = upper_map\<cdot>f\<cdot>(convex_to_upper\<cdot>xs)"
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   553
by (simp add: convex_map_def upper_map_def cfcomp_LAM)
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   554
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   555
lemma convex_to_upper_join [simp]:
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   556
  "convex_to_upper\<cdot>(convex_join\<cdot>xss) =
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   557
    upper_bind\<cdot>(convex_to_upper\<cdot>xss)\<cdot>convex_to_upper"
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   558
by (simp add: convex_join_def upper_join_def cfcomp_LAM eta_cfun)
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   559
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   560
text {* Convex to lower *}
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   561
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   562
lemma convex_le_imp_lower_le: "t \<le>\<natural> u \<Longrightarrow> t \<le>\<flat> u"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   563
unfolding convex_le_def by simp
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   564
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   565
definition
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   566
  convex_to_lower :: "'a convex_pd \<rightarrow> 'a lower_pd" where
41394
51c866d1b53b rename function ideal_completion.basis_fun to ideal_completion.extension
huffman
parents: 41289
diff changeset
   567
  "convex_to_lower = convex_pd.extension lower_principal"
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   568
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   569
lemma convex_to_lower_principal [simp]:
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   570
  "convex_to_lower\<cdot>(convex_principal t) = lower_principal t"
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   571
unfolding convex_to_lower_def
41394
51c866d1b53b rename function ideal_completion.basis_fun to ideal_completion.extension
huffman
parents: 41289
diff changeset
   572
apply (rule convex_pd.extension_principal)
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   573
apply (rule lower_pd.principal_mono)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   574
apply (erule convex_le_imp_lower_le)
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   575
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   576
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   577
lemma convex_to_lower_unit [simp]:
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   578
  "convex_to_lower\<cdot>{x}\<natural> = {x}\<flat>"
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   579
by (induct x rule: compact_basis.principal_induct, simp, simp)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   580
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   581
lemma convex_to_lower_plus [simp]:
41399
ad093e4638e2 changed syntax of powerdomain binary union operators
huffman
parents: 41394
diff changeset
   582
  "convex_to_lower\<cdot>(xs \<union>\<natural> ys) = convex_to_lower\<cdot>xs \<union>\<flat> convex_to_lower\<cdot>ys"
41402
b647212cee03 remove lemma ideal_completion.principal_induct2, use principal_induct twice instead
huffman
parents: 41399
diff changeset
   583
by (induct xs rule: convex_pd.principal_induct, simp,
b647212cee03 remove lemma ideal_completion.principal_induct2, use principal_induct twice instead
huffman
parents: 41399
diff changeset
   584
    induct ys rule: convex_pd.principal_induct, simp, simp)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   585
27289
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   586
lemma convex_to_lower_bind [simp]:
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   587
  "convex_to_lower\<cdot>(convex_bind\<cdot>xs\<cdot>f) =
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   588
    lower_bind\<cdot>(convex_to_lower\<cdot>xs)\<cdot>(convex_to_lower oo f)"
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   589
by (induct xs rule: convex_pd_induct, simp, simp, simp)
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   590
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   591
lemma convex_to_lower_map [simp]:
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   592
  "convex_to_lower\<cdot>(convex_map\<cdot>f\<cdot>xs) = lower_map\<cdot>f\<cdot>(convex_to_lower\<cdot>xs)"
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   593
by (simp add: convex_map_def lower_map_def cfcomp_LAM)
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   594
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   595
lemma convex_to_lower_join [simp]:
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   596
  "convex_to_lower\<cdot>(convex_join\<cdot>xss) =
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   597
    lower_bind\<cdot>(convex_to_lower\<cdot>xss)\<cdot>convex_to_lower"
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   598
by (simp add: convex_join_def lower_join_def cfcomp_LAM eta_cfun)
c49d427867aa move lemmas into locales;
huffman
parents: 27267
diff changeset
   599
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   600
text {* Ordering property *}
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   601
31076
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   602
lemma convex_pd_below_iff:
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   603
  "(xs \<sqsubseteq> ys) =
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   604
    (convex_to_upper\<cdot>xs \<sqsubseteq> convex_to_upper\<cdot>ys \<and>
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   605
     convex_to_lower\<cdot>xs \<sqsubseteq> convex_to_lower\<cdot>ys)"
39970
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   606
apply (induct xs rule: convex_pd.principal_induct, simp)
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   607
apply (induct ys rule: convex_pd.principal_induct, simp)
9023b897e67a simplify proofs of powerdomain inequalities
Brian Huffman <brianh@cs.pdx.edu>
parents: 37770
diff changeset
   608
apply (simp add: convex_le_def)
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   609
done
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   610
31076
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   611
lemmas convex_plus_below_plus_iff =
45606
b1e1508643b1 eliminated obsolete "standard";
wenzelm
parents: 42151
diff changeset
   612
  convex_pd_below_iff [where xs="xs \<union>\<natural> ys" and ys="zs \<union>\<natural> ws"]
b1e1508643b1 eliminated obsolete "standard";
wenzelm
parents: 42151
diff changeset
   613
  for xs ys zs ws
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   614
31076
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   615
lemmas convex_pd_below_simps =
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   616
  convex_unit_below_plus_iff
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   617
  convex_plus_below_unit_iff
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   618
  convex_plus_below_plus_iff
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   619
  convex_unit_below_iff
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   620
  convex_to_upper_unit
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   621
  convex_to_upper_plus
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   622
  convex_to_lower_unit
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   623
  convex_to_lower_plus
31076
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   624
  upper_pd_below_simps
99fe356cbbc2 rename constant sq_le to below; rename class sq_ord to below; less->below in many lemma names
huffman
parents: 30729
diff changeset
   625
  lower_pd_below_simps
26927
8684b5240f11 rename locales;
huffman
parents: 26806
diff changeset
   626
25904
8161f137b0e9 new theory of powerdomains
huffman
parents:
diff changeset
   627
end