src/HOLCF/Up1.ML

*** empty log message ***

(*  Title:      HOLCF/Up1.ML
    ID:         $Id$
    Author:     Franz Regensburger
    Copyright   1993  Technische Universitaet Muenchen
*)

open Up1;

qed_goalw "Exh_Up" Up1.thy [UU_up_def,Iup_def ]
        "z = UU_up | (? x. z = Iup(x))"
 (fn prems =>
        [
        (rtac (Rep_Up_inverse RS subst) 1),
        (res_inst_tac [("s","Rep_Up(z)")] sumE 1),
        (rtac disjI1 1),
        (res_inst_tac [("f","Abs_Up")] arg_cong 1),
        (rtac (unique_void2 RS subst) 1),
        (atac 1),
        (rtac disjI2 1),
        (rtac exI 1),
        (res_inst_tac [("f","Abs_Up")] arg_cong 1),
        (atac 1)
        ]);

qed_goal "inj_Abs_Up" Up1.thy "inj(Abs_Up)"
 (fn prems =>
        [
        (rtac inj_inverseI 1),
        (rtac Abs_Up_inverse 1)
        ]);

qed_goal "inj_Rep_Up" Up1.thy "inj(Rep_Up)"
 (fn prems =>
        [
        (rtac inj_inverseI 1),
        (rtac Rep_Up_inverse 1)
        ]);

qed_goalw "inject_Iup" Up1.thy [Iup_def] "Iup(x)=Iup(y) ==> x=y"
 (fn prems =>
        [
        (cut_facts_tac prems 1),
        (rtac (inj_Inr RS injD) 1),
        (rtac (inj_Abs_Up RS injD) 1),
        (atac 1)
        ]);

qed_goalw "defined_Iup" Up1.thy [Iup_def,UU_up_def] "Iup(x)~=UU_up"
 (fn prems =>
        [
        (rtac notI 1),
        (rtac notE 1),
        (rtac Inl_not_Inr 1),
        (rtac sym 1),
        (etac (inj_Abs_Up RS  injD) 1)
        ]);


qed_goal "upE"  Up1.thy
        "[| p=UU_up ==> Q; !!x. p=Iup(x)==>Q|] ==>Q"
 (fn prems =>
        [
        (rtac (Exh_Up RS disjE) 1),
        (eresolve_tac prems 1),
        (etac exE 1),
        (eresolve_tac prems 1)
        ]);

qed_goalw "Ifup1"  Up1.thy [Ifup_def,UU_up_def]
        "Ifup(f)(UU_up)=UU"
 (fn prems =>
        [
        (stac Abs_Up_inverse 1),
        (stac sum_case_Inl 1),
        (rtac refl 1)
        ]);

qed_goalw "Ifup2"  Up1.thy [Ifup_def,Iup_def]
        "Ifup(f)(Iup(x))=f`x"
 (fn prems =>
        [
        (stac Abs_Up_inverse 1),
        (stac sum_case_Inr 1),
        (rtac refl 1)
        ]);

val Up0_ss = (simpset_of "Cfun3") addsimps [Ifup1,Ifup2];

qed_goalw "less_up1a"  Up1.thy [less_up_def,UU_up_def]
        "less_up(UU_up)(z)"
 (fn prems =>
        [
        (stac Abs_Up_inverse 1),
        (stac sum_case_Inl 1),
        (rtac TrueI 1)
        ]);

qed_goalw "less_up1b"  Up1.thy [Iup_def,less_up_def,UU_up_def]
        "~less_up (Iup x) UU_up"
 (fn prems =>
        [
        (rtac notI 1),
        (rtac iffD1 1),
        (atac 2),
        (stac Abs_Up_inverse 1),
        (stac Abs_Up_inverse 1),
        (stac sum_case_Inr 1),
        (stac sum_case_Inl 1),
        (rtac refl 1)
        ]);

qed_goalw "less_up1c"  Up1.thy [Iup_def,less_up_def,UU_up_def]
        "less_up (Iup x) (Iup y)=(x<<y)"
 (fn prems =>
        [
        (stac Abs_Up_inverse 1),
        (stac Abs_Up_inverse 1),
        (stac sum_case_Inr 1),
        (stac sum_case_Inr 1),
        (rtac refl 1)
        ]);


qed_goal "refl_less_up"  Up1.thy "less_up p p"
 (fn prems =>
        [
        (res_inst_tac [("p","p")] upE 1),
        (hyp_subst_tac 1),
        (rtac less_up1a 1),
        (hyp_subst_tac 1),
        (rtac (less_up1c RS iffD2) 1),
        (rtac refl_less 1)
        ]);

qed_goal "antisym_less_up"  Up1.thy 
        "!!p1. [|less_up p1 p2;less_up p2 p1|] ==> p1=p2"
 (fn _ =>
        [
        (res_inst_tac [("p","p1")] upE 1),
        (hyp_subst_tac 1),
        (res_inst_tac [("p","p2")] upE 1),
        (etac sym 1),
        (hyp_subst_tac 1),
        (res_inst_tac [("P","less_up (Iup x) UU_up")] notE 1),
        (rtac less_up1b 1),
        (atac 1),
        (hyp_subst_tac 1),
        (res_inst_tac [("p","p2")] upE 1),
        (hyp_subst_tac 1),
        (res_inst_tac [("P","less_up (Iup x) UU_up")] notE 1),
        (rtac less_up1b 1),
        (atac 1),
        (hyp_subst_tac 1),
        (rtac arg_cong 1),
        (rtac antisym_less 1),
        (etac (less_up1c RS iffD1) 1),
        (etac (less_up1c RS iffD1) 1)
        ]);

qed_goal "trans_less_up"  Up1.thy 
        "[|less_up p1 p2;less_up p2 p3|] ==> less_up p1 p3"
 (fn prems =>
        [
        (cut_facts_tac prems 1),
        (res_inst_tac [("p","p1")] upE 1),
        (hyp_subst_tac 1),
        (rtac less_up1a 1),
        (hyp_subst_tac 1),
        (res_inst_tac [("p","p2")] upE 1),
        (hyp_subst_tac 1),
        (rtac notE 1),
        (rtac less_up1b 1),
        (atac 1),
        (hyp_subst_tac 1),
        (res_inst_tac [("p","p3")] upE 1),
        (hyp_subst_tac 1),
        (rtac notE 1),
        (rtac less_up1b 1),
        (atac 1),
        (hyp_subst_tac 1),
        (rtac (less_up1c RS iffD2) 1),
        (rtac trans_less 1),
        (etac (less_up1c RS iffD1) 1),
        (etac (less_up1c RS iffD1) 1)
        ]);