src/HOLCF/Cfun.thy
changeset 16699 24b494ff8f0f
parent 16417 9bc16273c2d4
child 16920 ded12c9e88c2
equal deleted inserted replaced
16698:53ba41c5fa7c 16699:24b494ff8f0f
     6 *)
     6 *)
     7 
     7 
     8 header {* The type of continuous functions *}
     8 header {* The type of continuous functions *}
     9 
     9 
    10 theory Cfun
    10 theory Cfun
    11 imports TypedefPcpo
    11 imports Pcpodef
    12 uses ("cont_proc.ML")
    12 uses ("cont_proc.ML")
    13 begin
    13 begin
    14 
    14 
    15 defaultsort cpo
    15 defaultsort cpo
    16 
    16 
    17 subsection {* Definition of continuous function type *}
    17 subsection {* Definition of continuous function type *}
    18 
    18 
    19 typedef (CFun)  ('a, 'b) "->" (infixr 0) = "{f::'a => 'b. cont f}"
    19 lemma Ex_cont: "\<exists>f. cont f"
    20 by (rule exI, fast intro: cont_const)
    20 by (rule exI, rule cont_const)
       
    21 
       
    22 lemma adm_cont: "adm cont"
       
    23 by (rule admI, rule cont_lub_fun)
       
    24 
       
    25 cpodef (CFun)  ('a, 'b) "->" (infixr 0) = "{f::'a => 'b. cont f}"
       
    26 by (simp add: Ex_cont adm_cont)
    21 
    27 
    22 syntax
    28 syntax
    23   Rep_CFun :: "('a -> 'b) => ('a => 'b)" ("_$_" [999,1000] 999)
    29   Rep_CFun :: "('a -> 'b) => ('a => 'b)" ("_$_" [999,1000] 999)
    24                                                 (* application *)
    30                                                 (* application *)
    25   Abs_CFun :: "('a => 'b) => ('a -> 'b)" (binder "LAM " 10)
    31   Abs_CFun :: "('a => 'b) => ('a -> 'b)" (binder "LAM " 10)
    34 syntax (HTML output)
    40 syntax (HTML output)
    35   Rep_CFun :: "('a -> 'b) => ('a => 'b)" ("(_\<cdot>_)" [999,1000] 999)
    41   Rep_CFun :: "('a -> 'b) => ('a => 'b)" ("(_\<cdot>_)" [999,1000] 999)
    36 
    42 
    37 subsection {* Class instances *}
    43 subsection {* Class instances *}
    38 
    44 
    39 instance "->"  :: (cpo, cpo) sq_ord ..
       
    40 
       
    41 defs (overloaded)
       
    42   less_cfun_def: "(op \<sqsubseteq>) \<equiv> (\<lambda>f g. Rep_CFun f \<sqsubseteq> Rep_CFun g)"
       
    43 
       
    44 lemma adm_CFun: "adm (\<lambda>f. f \<in> CFun)"
       
    45 by (simp add: CFun_def, rule admI, rule cont_lub_fun)
       
    46 
       
    47 lemma UU_CFun: "\<bottom> \<in> CFun"
    45 lemma UU_CFun: "\<bottom> \<in> CFun"
    48 by (simp add: CFun_def inst_fun_pcpo cont_const)
    46 by (simp add: CFun_def inst_fun_pcpo cont_const)
    49 
    47 
    50 instance "->" :: (cpo, cpo) po
       
    51 by (rule typedef_po [OF type_definition_CFun less_cfun_def])
       
    52 
       
    53 instance "->" :: (cpo, cpo) cpo
       
    54 by (rule typedef_cpo [OF type_definition_CFun less_cfun_def adm_CFun])
       
    55 
       
    56 instance "->" :: (cpo, pcpo) pcpo
    48 instance "->" :: (cpo, pcpo) pcpo
    57 by (rule typedef_pcpo_UU [OF type_definition_CFun less_cfun_def UU_CFun])
    49 by (rule typedef_pcpo_UU [OF type_definition_CFun less_CFun_def UU_CFun])
    58 
       
    59 lemmas cont_Rep_CFun =
       
    60   typedef_cont_Rep [OF type_definition_CFun less_cfun_def adm_CFun]
       
    61 
       
    62 lemmas cont_Abs_CFun = 
       
    63   typedef_cont_Abs [OF type_definition_CFun less_cfun_def adm_CFun]
       
    64 
    50 
    65 lemmas Rep_CFun_strict =
    51 lemmas Rep_CFun_strict =
    66   typedef_Rep_strict [OF type_definition_CFun less_cfun_def UU_CFun]
    52   typedef_Rep_strict [OF type_definition_CFun less_CFun_def UU_CFun]
    67 
    53 
    68 lemmas Abs_CFun_strict =
    54 lemmas Abs_CFun_strict =
    69   typedef_Abs_strict [OF type_definition_CFun less_cfun_def UU_CFun]
    55   typedef_Abs_strict [OF type_definition_CFun less_CFun_def UU_CFun]
    70 
    56 
    71 text {* Additional lemma about the isomorphism between
    57 text {* Additional lemma about the isomorphism between
    72         @{typ "'a -> 'b"} and @{term CFun} *}
    58         @{typ "'a -> 'b"} and @{term CFun} *}
    73 
    59 
    74 lemma Abs_CFun_inverse2: "cont f \<Longrightarrow> Rep_CFun (Abs_CFun f) = f"
    60 lemma Abs_CFun_inverse2: "cont f \<Longrightarrow> Rep_CFun (Abs_CFun f) = f"
   134 by (rule cont_Rep_CFun1 [THEN contE])
   120 by (rule cont_Rep_CFun1 [THEN contE])
   135 
   121 
   136 text {* Extensionality wrt. @{term "op <<"} in @{typ "'a -> 'b"} *}
   122 text {* Extensionality wrt. @{term "op <<"} in @{typ "'a -> 'b"} *}
   137 
   123 
   138 lemma less_cfun_ext: "(\<And>x. f\<cdot>x \<sqsubseteq> g\<cdot>x) \<Longrightarrow> f \<sqsubseteq> g"
   124 lemma less_cfun_ext: "(\<And>x. f\<cdot>x \<sqsubseteq> g\<cdot>x) \<Longrightarrow> f \<sqsubseteq> g"
   139 by (simp add: less_cfun_def less_fun_def)
   125 by (simp add: less_CFun_def less_fun_def)
   140 
   126 
   141 text {* monotonicity of application *}
   127 text {* monotonicity of application *}
   142 
   128 
   143 lemma monofun_cfun_fun: "f \<sqsubseteq> g \<Longrightarrow> f\<cdot>x \<sqsubseteq> g\<cdot>x"
   129 lemma monofun_cfun_fun: "f \<sqsubseteq> g \<Longrightarrow> f\<cdot>x \<sqsubseteq> g\<cdot>x"
   144 by (simp add: less_cfun_def less_fun_def)
   130 by (simp add: less_CFun_def less_fun_def)
   145 
   131 
   146 lemma monofun_cfun_arg: "x \<sqsubseteq> y \<Longrightarrow> f\<cdot>x \<sqsubseteq> f\<cdot>y"
   132 lemma monofun_cfun_arg: "x \<sqsubseteq> y \<Longrightarrow> f\<cdot>x \<sqsubseteq> f\<cdot>y"
   147 by (rule monofun_Rep_CFun2 [THEN monofunE])
   133 by (rule monofun_Rep_CFun2 [THEN monofunE])
   148 
   134 
   149 lemma monofun_cfun: "\<lbrakk>f \<sqsubseteq> g; x \<sqsubseteq> y\<rbrakk> \<Longrightarrow> f\<cdot>x \<sqsubseteq> g\<cdot>y"
   135 lemma monofun_cfun: "\<lbrakk>f \<sqsubseteq> g; x \<sqsubseteq> y\<rbrakk> \<Longrightarrow> f\<cdot>x \<sqsubseteq> g\<cdot>y"
   202 apply (simp add: monofun_Rep_CFun2)
   188 apply (simp add: monofun_Rep_CFun2)
   203 done
   189 done
   204 
   190 
   205 text {* a lemma about the exchange of lubs for type @{typ "'a -> 'b"} *}
   191 text {* a lemma about the exchange of lubs for type @{typ "'a -> 'b"} *}
   206 
   192 
   207 lemma ex_lub_cfun: "[| chain(F); chain(Y) |] ==> 
   193 lemma ex_lub_cfun:
   208                 lub(range(%j. lub(range(%i. F(j)$(Y i))))) = 
   194   "\<lbrakk>chain F; chain Y\<rbrakk> \<Longrightarrow> (\<Squnion>j. \<Squnion>i. F j\<cdot>(Y i)) = (\<Squnion>i. \<Squnion>j. F j\<cdot>(Y i))"
   209                 lub(range(%i. lub(range(%j. F(j)$(Y i)))))"
       
   210 by (simp add: diag_lub ch2ch_Rep_CFunL ch2ch_Rep_CFunR)
   195 by (simp add: diag_lub ch2ch_Rep_CFunL ch2ch_Rep_CFunR)
   211 
   196 
   212 text {* the lub of a chain of cont. functions is continuous *}
   197 text {* the lub of a chain of cont. functions is continuous *}
   213 
   198 
   214 lemma cont_lub_cfun: "chain F \<Longrightarrow> cont (\<lambda>x. \<Squnion>i. F i\<cdot>x)"
   199 lemma cont_lub_cfun: "chain F \<Longrightarrow> cont (\<lambda>x. \<Squnion>i. F i\<cdot>x)"
   220 text {* type @{typ "'a -> 'b"} is chain complete *}
   205 text {* type @{typ "'a -> 'b"} is chain complete *}
   221 
   206 
   222 lemma lub_cfun: "chain F \<Longrightarrow> range F <<| (LAM x. LUB i. F i$x)"
   207 lemma lub_cfun: "chain F \<Longrightarrow> range F <<| (LAM x. LUB i. F i$x)"
   223 apply (subst thelub_fun [symmetric])
   208 apply (subst thelub_fun [symmetric])
   224 apply (erule monofun_Rep_CFun [THEN ch2ch_monofun])
   209 apply (erule monofun_Rep_CFun [THEN ch2ch_monofun])
   225 apply (erule typedef_is_lub [OF type_definition_CFun less_cfun_def adm_CFun])
   210 apply (erule typedef_is_lub [OF type_definition_CFun less_CFun_def adm_CFun])
   226 done
   211 done
   227 
   212 
   228 lemmas thelub_cfun = lub_cfun [THEN thelubI, standard]
   213 lemmas thelub_cfun = lub_cfun [THEN thelubI, standard]
   229  -- {* @{thm thelub_cfun} *} (* chain F \<Longrightarrow> lub (range F) = (\<Lambda>x. \<Squnion>i. F i\<cdot>x) *)
   214  -- {* @{thm thelub_cfun} *} (* chain F \<Longrightarrow> lub (range F) = (\<Lambda>x. \<Squnion>i. F i\<cdot>x) *)
   230 
   215 
   231 subsection {* Miscellaneous *}
   216 subsection {* Miscellaneous *}
   232 
   217 
   233 text {* Monotonicity of @{term Abs_CFun} *}
   218 text {* Monotonicity of @{term Abs_CFun} *}
   234 
   219 
   235 lemma semi_monofun_Abs_CFun: "[| cont(f); cont(g); f<<g|] ==> Abs_CFun(f)<<Abs_CFun(g)"
   220 lemma semi_monofun_Abs_CFun:
   236 by (simp add: less_cfun_def Abs_CFun_inverse2)
   221   "\<lbrakk>cont f; cont g; f \<sqsubseteq> g\<rbrakk> \<Longrightarrow> Abs_CFun f \<sqsubseteq> Abs_CFun g"
       
   222 by (simp add: less_CFun_def Abs_CFun_inverse2)
   237 
   223 
   238 text {* for compatibility with old HOLCF-Version *}
   224 text {* for compatibility with old HOLCF-Version *}
   239 lemma inst_cfun_pcpo: "\<bottom> = (\<Lambda> x. \<bottom>)"
   225 lemma inst_cfun_pcpo: "\<bottom> = (\<Lambda> x. \<bottom>)"
   240 by (simp add: inst_fun_pcpo [symmetric] Abs_CFun_strict)
   226 by (simp add: inst_fun_pcpo [symmetric] Abs_CFun_strict)
   241 
   227 
   452 done
   438 done
   453 
   439 
   454 lemma contlub_Istrictify2: "contlub (\<lambda>x. Istrictify f x)"
   440 lemma contlub_Istrictify2: "contlub (\<lambda>x. Istrictify f x)"
   455 apply (rule contlubI)
   441 apply (rule contlubI)
   456 apply (case_tac "lub (range Y) = \<bottom>")
   442 apply (case_tac "lub (range Y) = \<bottom>")
   457 apply (simp add: Istrictify1 chain_UU_I thelub_const)
   443 apply (drule (1) chain_UU_I)
       
   444 apply (simp add: Istrictify1 thelub_const)
   458 apply (simp add: Istrictify2)
   445 apply (simp add: Istrictify2)
   459 apply (simp add: contlub_cfun_arg)
   446 apply (simp add: contlub_cfun_arg)
   460 apply (rule lub_equal2)
   447 apply (rule lub_equal2)
   461 apply (rule chain_mono2 [THEN exE])
   448 apply (rule chain_mono2 [THEN exE])
   462 apply (erule chain_UU_I_inverse2)
   449 apply (erule chain_UU_I_inverse2)