diff -r 1c0b5bfa52a1 -r f432973ce0f6 src/HOLCF/Domain.thy --- a/src/HOLCF/Domain.thy Wed Nov 17 06:49:23 2010 -0800 +++ b/src/HOLCF/Domain.thy Wed Nov 17 08:47:58 2010 -0800 @@ -237,13 +237,13 @@ unfolding isodefl_def by (simp add: cfun_eq_iff assms prj_emb_prj emb_prj_emb) -lemma isodefl_cfun: +lemma isodefl_sfun: "isodefl d1 t1 \ isodefl d2 t2 \ - isodefl (cfun_map\d1\d2) (cfun_defl\t1\t2)" + isodefl (sfun_map\d1\d2) (sfun_defl\t1\t2)" apply (rule isodeflI) -apply (simp add: cast_cfun_defl cast_isodefl) -apply (simp add: emb_cfun_def prj_cfun_def) -apply (simp add: cfun_map_map cfcomp1) +apply (simp add: cast_sfun_defl cast_isodefl) +apply (simp add: emb_sfun_def prj_sfun_def) +apply (simp add: sfun_map_map isodefl_strict) done lemma isodefl_ssum: @@ -299,6 +299,23 @@ apply (simp add: cfcomp1 encode_prod_u_map cast_sprod_defl sprod_map_map) done +lemma encode_cfun_map: + "encode_cfun\(cfun_map\f\g\(decode_cfun\x)) + = sfun_map\(u_map\f)\g\x" +unfolding encode_cfun_def decode_cfun_def +apply (simp add: sfun_eq_iff cfun_map_def sfun_map_def) +apply (rule cfun_eqI, rename_tac y, case_tac y, simp_all) +done + +lemma isodefl_cfun: + "isodefl (u_map\d1) t1 \ isodefl d2 t2 \ + isodefl (cfun_map\d1\d2) (sfun_defl\t1\t2)" +apply (rule isodeflI) +apply (simp add: cast_sfun_defl cast_isodefl) +apply (simp add: emb_cfun_def prj_cfun_def encode_cfun_map) +apply (simp add: sfun_map_map isodefl_strict) +done + subsection {* Setting up the domain package *} use "Tools/Domain/domain_isomorphism.ML" @@ -308,23 +325,24 @@ setup Domain_Isomorphism.setup lemmas [domain_defl_simps] = - DEFL_cfun DEFL_ssum DEFL_sprod DEFL_prod DEFL_u + DEFL_cfun DEFL_sfun DEFL_ssum DEFL_sprod DEFL_prod DEFL_u liftdefl_eq LIFTDEFL_prod lemmas [domain_map_ID] = - cfun_map_ID ssum_map_ID sprod_map_ID cprod_map_ID u_map_ID + cfun_map_ID sfun_map_ID ssum_map_ID sprod_map_ID cprod_map_ID u_map_ID lemmas [domain_isodefl] = - isodefl_u isodefl_cfun isodefl_ssum isodefl_sprod - isodefl_cprod isodefl_cprod_u + isodefl_u isodefl_sfun isodefl_ssum isodefl_sprod + isodefl_cfun isodefl_cprod isodefl_cprod_u lemmas [domain_deflation] = - deflation_cfun_map deflation_ssum_map deflation_sprod_map - deflation_cprod_map deflation_u_map + deflation_cfun_map deflation_sfun_map deflation_ssum_map + deflation_sprod_map deflation_cprod_map deflation_u_map setup {* fold Domain_Take_Proofs.add_map_function [(@{type_name cfun}, @{const_name cfun_map}, [true, true]), + (@{type_name "sfun"}, @{const_name sfun_map}, [true, true]), (@{type_name ssum}, @{const_name ssum_map}, [true, true]), (@{type_name sprod}, @{const_name sprod_map}, [true, true]), (@{type_name prod}, @{const_name cprod_map}, [true, true]),