src/HOLCF/Cfun.thy
changeset 16098 6aef81a6ddd3
parent 16094 a92ee2833938
child 16209 36ee7f6af79f
equal deleted inserted replaced
16097:8d41765e2884 16098:6aef81a6ddd3
    71 text {* Eta - equality for continuous functions *}
    71 text {* Eta - equality for continuous functions *}
    72 
    72 
    73 lemma eta_cfun: "(LAM x. f$x) = f"
    73 lemma eta_cfun: "(LAM x. f$x) = f"
    74 by (rule Rep_CFun_inverse)
    74 by (rule Rep_CFun_inverse)
    75 
    75 
    76 subsection {* Type @{typ "'a -> 'b"} is a partial order *}
    76 subsection {* Class instances *}
    77 
    77 
    78 instance "->"  :: (cpo, cpo) sq_ord ..
    78 instance "->"  :: (cpo, cpo) sq_ord ..
    79 
    79 
    80 defs (overloaded)
    80 defs (overloaded)
    81   less_cfun_def: "(op <<) == (% fo1 fo2. Rep_CFun fo1 << Rep_CFun fo2 )"
    81   less_cfun_def: "(op <<) == (% fo1 fo2. Rep_CFun fo1 << Rep_CFun fo2 )"
    82 
    82 
       
    83 lemma adm_CFun: "adm (\<lambda>f. f \<in> CFun)"
       
    84 by (simp add: CFun_def, rule admI, rule cont_lub_fun)
       
    85 
       
    86 lemma UU_CFun: "\<bottom> \<in> CFun"
       
    87 by (simp add: CFun_def inst_fun_pcpo cont_const)
       
    88 
    83 instance "->" :: (cpo, cpo) po
    89 instance "->" :: (cpo, cpo) po
    84 by (rule typedef_po [OF type_definition_CFun less_cfun_def])
    90 by (rule typedef_po [OF type_definition_CFun less_cfun_def])
       
    91 
       
    92 instance "->" :: (cpo, cpo) cpo
       
    93 by (rule typedef_cpo [OF type_definition_CFun less_cfun_def adm_CFun])
       
    94 
       
    95 instance "->" :: (cpo, pcpo) pcpo
       
    96 by (rule typedef_pcpo_UU [OF type_definition_CFun less_cfun_def UU_CFun])
       
    97 
       
    98 lemmas cont_Rep_CFun =
       
    99   typedef_cont_Rep [OF type_definition_CFun less_cfun_def adm_CFun]
       
   100 
       
   101 lemmas cont_Abs_CFun = 
       
   102   typedef_cont_Abs [OF type_definition_CFun less_cfun_def adm_CFun]
       
   103 
       
   104 lemmas strict_Rep_CFun =
       
   105   typedef_strict_Rep [OF type_definition_CFun less_cfun_def UU_CFun]
       
   106 
       
   107 lemmas strict_Abs_CFun =
       
   108   typedef_strict_Abs [OF type_definition_CFun less_cfun_def UU_CFun]
    85 
   109 
    86 text {* for compatibility with old HOLCF-Version *}
   110 text {* for compatibility with old HOLCF-Version *}
    87 lemma inst_cfun_po: "(op <<)=(%f1 f2. Rep_CFun f1 << Rep_CFun f2)"
   111 lemma inst_cfun_po: "(op <<)=(%f1 f2. Rep_CFun f1 << Rep_CFun f2)"
    88 apply (fold less_cfun_def)
   112 apply (fold less_cfun_def)
    89 apply (rule refl)
   113 apply (rule refl)
   150  -- {* @{thm contlub_cfun_arg} *} (* chain(?x1) ==> ?fo4$(lub (range ?x1)) = lub (range (%i. ?fo4$(?x1 i))) *)
   174  -- {* @{thm contlub_cfun_arg} *} (* chain(?x1) ==> ?fo4$(lub (range ?x1)) = lub (range (%i. ?fo4$(?x1 i))) *)
   151 
   175 
   152 text {* @{term Rep_CFun} is monotone in its 'first' argument *}
   176 text {* @{term Rep_CFun} is monotone in its 'first' argument *}
   153 
   177 
   154 lemma monofun_Rep_CFun1: "monofun(Rep_CFun)"
   178 lemma monofun_Rep_CFun1: "monofun(Rep_CFun)"
   155 apply (rule monofunI [rule_format])
   179 by (rule cont_Rep_CFun [THEN cont2mono])
   156 apply (erule less_cfun [THEN subst])
       
   157 done
       
   158 
   180 
   159 text {* monotonicity of application @{term Rep_CFun} in mixfix syntax @{text "[_]_"} *}
   181 text {* monotonicity of application @{term Rep_CFun} in mixfix syntax @{text "[_]_"} *}
   160 
   182 
   161 lemma monofun_cfun_fun: "f1 << f2 ==> f1$x << f2$x"
   183 lemma monofun_cfun_fun: "f1 << f2 ==> f1$x << f2$x"
   162 apply (rule_tac x = "x" in spec)
   184 apply (rule_tac x = "x" in spec)
   251 lemmas thelub_cfun = lub_cfun [THEN thelubI, standard]
   273 lemmas thelub_cfun = lub_cfun [THEN thelubI, standard]
   252  -- {* @{thm thelub_cfun} *} (* 
   274  -- {* @{thm thelub_cfun} *} (* 
   253 chain(?CCF1) ==>  lub (range ?CCF1) = (LAM x. lub (range (%i. ?CCF1 i$x)))
   275 chain(?CCF1) ==>  lub (range ?CCF1) = (LAM x. lub (range (%i. ?CCF1 i$x)))
   254 *)
   276 *)
   255 
   277 
   256 lemma cpo_cfun: "chain(CCF::nat=>('a->'b)) ==> ? x. range(CCF) <<| x"
       
   257 apply (rule exI)
       
   258 apply (erule lub_cfun)
       
   259 done
       
   260 
       
   261 instance "->" :: (cpo, cpo) cpo
       
   262 by intro_classes (rule cpo_cfun)
       
   263 
       
   264 subsection {* Miscellaneous *}
   278 subsection {* Miscellaneous *}
   265 
   279 
   266 text {* Extensionality in @{typ "'a -> 'b"} *}
   280 text {* Extensionality in @{typ "'a -> 'b"} *}
   267 
   281 
   268 lemma ext_cfun: "(!!x. f$x = g$x) ==> f = g"
   282 lemma ext_cfun: "(!!x. f$x = g$x) ==> f = g"
   286 apply (rule cont_Rep_CFun2)
   300 apply (rule cont_Rep_CFun2)
   287 apply (rule less_fun [THEN iffD2])
   301 apply (rule less_fun [THEN iffD2])
   288 apply simp
   302 apply simp
   289 done
   303 done
   290 
   304 
   291 subsection {* Class instance of @{typ "'a -> 'b"} for class pcpo *}
       
   292 
       
   293 instance "->" :: (cpo, pcpo) pcpo
       
   294 by (intro_classes, rule least_cfun)
       
   295 
       
   296 text {* for compatibility with old HOLCF-Version *}
   305 text {* for compatibility with old HOLCF-Version *}
   297 lemma inst_cfun_pcpo: "UU = Abs_CFun(%x. UU)"
   306 lemma inst_cfun_pcpo: "UU = Abs_CFun(%x. UU)"
   298 apply (simp add: UU_def UU_cfun_def)
   307 apply (simp add: UU_def UU_cfun_def)
   299 done
   308 done
   300 
   309 
   301 subsection {* Continuity of application *}
   310 subsection {* Continuity of application *}
   302 
   311 
   303 text {* the contlub property for @{term Rep_CFun} its 'first' argument *}
   312 text {* the contlub property for @{term Rep_CFun} its 'first' argument *}
   304 
   313 
   305 lemma contlub_Rep_CFun1: "contlub(Rep_CFun)"
   314 lemma contlub_Rep_CFun1: "contlub(Rep_CFun)"
   306 apply (rule contlubI [rule_format])
   315 by (rule cont_Rep_CFun [THEN cont2contlub])
   307 apply (rule ext)
       
   308 apply (subst thelub_cfun)
       
   309 apply assumption
       
   310 apply (subst Cfunapp2)
       
   311 apply (erule cont_lubcfun)
       
   312 apply (subst thelub_fun)
       
   313 apply (erule monofun_Rep_CFun1 [THEN ch2ch_monofun])
       
   314 apply (rule refl)
       
   315 done
       
   316 
   316 
   317 text {* the cont property for @{term Rep_CFun} in its first argument *}
   317 text {* the cont property for @{term Rep_CFun} in its first argument *}
   318 
   318 
   319 lemma cont_Rep_CFun1: "cont(Rep_CFun)"
   319 lemma cont_Rep_CFun1: "cont(Rep_CFun)"
   320 apply (rule monocontlub2cont)
   320 by (rule cont_Rep_CFun)
   321 apply (rule monofun_Rep_CFun1)
       
   322 apply (rule contlub_Rep_CFun1)
       
   323 done
       
   324 
   321 
   325 text {* contlub, cont properties of @{term Rep_CFun} in its first argument in mixfix @{text "_[_]"} *}
   322 text {* contlub, cont properties of @{term Rep_CFun} in its first argument in mixfix @{text "_[_]"} *}
   326 
   323 
   327 lemma contlub_cfun_fun: 
   324 lemma contlub_cfun_fun: 
   328 "chain(FY) ==> 
   325 "chain(FY) ==> 
   378 
   375 
   379 lemma cont2mono_LAM:
   376 lemma cont2mono_LAM:
   380 assumes p1: "!!x. cont(c1 x)"
   377 assumes p1: "!!x. cont(c1 x)"
   381 assumes p2: "!!y. monofun(%x. c1 x y)"
   378 assumes p2: "!!y. monofun(%x. c1 x y)"
   382 shows "monofun(%x. LAM y. c1 x y)"
   379 shows "monofun(%x. LAM y. c1 x y)"
   383 apply (rule monofunI)
   380 apply (rule monofunI [rule_format])
   384 apply (intro strip)
   381 apply (rule less_cfun2)
   385 apply (subst less_cfun)
   382 apply (simp add: beta_cfun p1)
   386 apply (subst less_fun)
   383 apply (erule p2 [THEN monofunE [rule_format]])
   387 apply (rule allI)
       
   388 apply (subst beta_cfun)
       
   389 apply (rule p1)
       
   390 apply (subst beta_cfun)
       
   391 apply (rule p1)
       
   392 apply (erule p2 [THEN monofunE, THEN spec, THEN spec, THEN mp])
       
   393 done
   384 done
   394 
   385 
   395 text {* cont2cont Lemma for @{term "%x. LAM y. c1 x y"} *}
   386 text {* cont2cont Lemma for @{term "%x. LAM y. c1 x y"} *}
   396 
   387 
   397 lemma cont2cont_LAM:
   388 lemma cont2cont_LAM:
   398 assumes p1: "!!x. cont(c1 x)"
   389 assumes p1: "!!x. cont(c1 x)"
   399 assumes p2: "!!y. cont(%x. c1 x y)"
   390 assumes p2: "!!y. cont(%x. c1 x y)"
   400 shows "cont(%x. LAM y. c1 x y)"
   391 shows "cont(%x. LAM y. c1 x y)"
   401 apply (rule monocontlub2cont)
   392 apply (rule cont_Abs_CFun)
   402 apply (rule p1 [THEN cont2mono_LAM])
   393 apply (simp add: p1 CFun_def)
   403 apply (rule p2 [THEN cont2mono])
   394 apply (simp add: p2 cont2cont_CF1L_rev)
   404 apply (rule contlubI)
       
   405 apply (intro strip)
       
   406 apply (subst thelub_cfun)
       
   407 apply (rule p1 [THEN cont2mono_LAM, THEN ch2ch_monofun])
       
   408 apply (rule p2 [THEN cont2mono])
       
   409 apply assumption
       
   410 apply (rule_tac f = "Abs_CFun" in arg_cong)
       
   411 apply (rule ext)
       
   412 apply (subst p1 [THEN beta_cfun, THEN ext])
       
   413 apply (erule p2 [THEN cont2contlub, THEN contlubE, THEN spec, THEN mp])
       
   414 done
   395 done
   415 
   396 
   416 text {* cont2cont Lemma for @{term "%x. LAM y. c1 x$y"} *}
   397 text {* cont2cont Lemma for @{term "%x. LAM y. c1 x$y"} *}
   417 
   398 
   418 lemma cont2cont_eta: "cont c1 ==> cont (%x. LAM y. c1 x$y)"
   399 lemma cont2cont_eta: "cont c1 ==> cont (%x. LAM y. c1 x$y)"