src/CCL/CCL.thy
changeset 58977 9576b510f6a2
parent 58976 b38a54bbfbd6
child 59498 50b60f501b05
equal deleted inserted replaced
58976:b38a54bbfbd6 58977:9576b510f6a2
    25 instance i :: prog ..
    25 instance i :: prog ..
    26 
    26 
    27 
    27 
    28 consts
    28 consts
    29   (*** Evaluation Judgement ***)
    29   (*** Evaluation Judgement ***)
    30   Eval      ::       "[i,i]=>prop"          (infixl "--->" 20)
    30   Eval      ::       "[i,i]\<Rightarrow>prop"          (infixl "--->" 20)
    31 
    31 
    32   (*** Bisimulations for pre-order and equality ***)
    32   (*** Bisimulations for pre-order and equality ***)
    33   po          ::       "['a,'a]=>o"           (infixl "[=" 50)
    33   po          ::       "['a,'a]\<Rightarrow>o"           (infixl "[=" 50)
    34 
    34 
    35   (*** Term Formers ***)
    35   (*** Term Formers ***)
    36   true        ::       "i"
    36   true        ::       "i"
    37   false       ::       "i"
    37   false       ::       "i"
    38   pair        ::       "[i,i]=>i"             ("(1<_,/_>)")
    38   pair        ::       "[i,i]\<Rightarrow>i"             ("(1<_,/_>)")
    39   lambda      ::       "(i=>i)=>i"            (binder "lam " 55)
    39   lambda      ::       "(i\<Rightarrow>i)\<Rightarrow>i"            (binder "lam " 55)
    40   "case"      ::       "[i,i,i,[i,i]=>i,(i=>i)=>i]=>i"
    40   "case"      ::       "[i,i,i,[i,i]\<Rightarrow>i,(i\<Rightarrow>i)\<Rightarrow>i]\<Rightarrow>i"
    41   "apply"     ::       "[i,i]=>i"             (infixl "`" 56)
    41   "apply"     ::       "[i,i]\<Rightarrow>i"             (infixl "`" 56)
    42   bot         ::       "i"
    42   bot         ::       "i"
    43 
    43 
    44   (******* EVALUATION SEMANTICS *******)
    44   (******* EVALUATION SEMANTICS *******)
    45 
    45 
    46   (**  This is the evaluation semantics from which the axioms below were derived.  **)
    46   (**  This is the evaluation semantics from which the axioms below were derived.  **)
    51   trueV:       "true ---> true" and
    51   trueV:       "true ---> true" and
    52   falseV:      "false ---> false" and
    52   falseV:      "false ---> false" and
    53   pairV:       "<a,b> ---> <a,b>" and
    53   pairV:       "<a,b> ---> <a,b>" and
    54   lamV:        "\<And>b. lam x. b(x) ---> lam x. b(x)" and
    54   lamV:        "\<And>b. lam x. b(x) ---> lam x. b(x)" and
    55 
    55 
    56   caseVtrue:   "[| t ---> true;  d ---> c |] ==> case(t,d,e,f,g) ---> c" and
    56   caseVtrue:   "\<lbrakk>t ---> true; d ---> c\<rbrakk> \<Longrightarrow> case(t,d,e,f,g) ---> c" and
    57   caseVfalse:  "[| t ---> false;  e ---> c |] ==> case(t,d,e,f,g) ---> c" and
    57   caseVfalse:  "\<lbrakk>t ---> false; e ---> c\<rbrakk> \<Longrightarrow> case(t,d,e,f,g) ---> c" and
    58   caseVpair:   "[| t ---> <a,b>;  f(a,b) ---> c |] ==> case(t,d,e,f,g) ---> c" and
    58   caseVpair:   "\<lbrakk>t ---> <a,b>; f(a,b) ---> c\<rbrakk> \<Longrightarrow> case(t,d,e,f,g) ---> c" and
    59   caseVlam:    "\<And>b. [| t ---> lam x. b(x);  g(b) ---> c |] ==> case(t,d,e,f,g) ---> c"
    59   caseVlam:    "\<And>b. \<lbrakk>t ---> lam x. b(x); g(b) ---> c\<rbrakk> \<Longrightarrow> case(t,d,e,f,g) ---> c"
    60 
    60 
    61   (*** Properties of evaluation: note that "t ---> c" impies that c is canonical ***)
    61   (*** Properties of evaluation: note that "t ---> c" impies that c is canonical ***)
    62 
    62 
    63 axiomatization where
    63 axiomatization where
    64   canonical:  "[| t ---> c; c==true ==> u--->v;
    64   canonical:  "\<lbrakk>t ---> c; c==true \<Longrightarrow> u--->v;
    65                           c==false ==> u--->v;
    65                           c==false \<Longrightarrow> u--->v;
    66                     !!a b. c==<a,b> ==> u--->v;
    66                     \<And>a b. c==<a,b> \<Longrightarrow> u--->v;
    67                       !!f. c==lam x. f(x) ==> u--->v |] ==>
    67                       \<And>f. c==lam x. f(x) \<Longrightarrow> u--->v\<rbrakk> \<Longrightarrow>
    68              u--->v"
    68              u--->v"
    69 
    69 
    70   (* Should be derivable - but probably a bitch! *)
    70   (* Should be derivable - but probably a bitch! *)
    71 axiomatization where
    71 axiomatization where
    72   substitute: "[| a==a'; t(a)--->c(a) |] ==> t(a')--->c(a')"
    72   substitute: "\<lbrakk>a==a'; t(a)--->c(a)\<rbrakk> \<Longrightarrow> t(a')--->c(a')"
    73 
    73 
    74   (************** LOGIC ***************)
    74   (************** LOGIC ***************)
    75 
    75 
    76   (*** Definitions used in the following rules ***)
    76   (*** Definitions used in the following rules ***)
    77 
    77 
    78 axiomatization where
    78 axiomatization where
    79   bot_def:         "bot == (lam x. x`x)`(lam x. x`x)" and
    79   bot_def:         "bot == (lam x. x`x)`(lam x. x`x)" and
    80   apply_def:     "f ` t == case(f,bot,bot,%x y. bot,%u. u(t))"
    80   apply_def:     "f ` t == case(f, bot, bot, \<lambda>x y. bot, \<lambda>u. u(t))"
    81 
    81 
    82 definition "fix" :: "(i=>i)=>i"
    82 definition "fix" :: "(i\<Rightarrow>i)\<Rightarrow>i"
    83   where "fix(f) == (lam x. f(x`x))`(lam x. f(x`x))"
    83   where "fix(f) == (lam x. f(x`x))`(lam x. f(x`x))"
    84 
    84 
    85   (*  The pre-order ([=) is defined as a simulation, and behavioural equivalence (=) *)
    85   (*  The pre-order ([=) is defined as a simulation, and behavioural equivalence (=) *)
    86   (*  as a bisimulation.  They can both be expressed as (bi)simulations up to        *)
    86   (*  as a bisimulation.  They can both be expressed as (bi)simulations up to        *)
    87   (*  behavioural equivalence (ie the relations PO and EQ defined below).            *)
    87   (*  behavioural equivalence (ie the relations PO and EQ defined below).            *)
    88 
    88 
    89 definition SIM :: "[i,i,i set]=>o"
    89 definition SIM :: "[i,i,i set]\<Rightarrow>o"
    90   where
    90   where
    91   "SIM(t,t',R) ==  (t=true & t'=true) | (t=false & t'=false) |
    91   "SIM(t,t',R) ==  (t=true \<and> t'=true) | (t=false \<and> t'=false) |
    92                   (EX a a' b b'. t=<a,b> & t'=<a',b'> & <a,a'> : R & <b,b'> : R) |
    92                   (\<exists>a a' b b'. t=<a,b> \<and> t'=<a',b'> \<and> <a,a'> : R \<and> <b,b'> : R) |
    93                   (EX f f'. t=lam x. f(x) & t'=lam x. f'(x) & (ALL x.<f(x),f'(x)> : R))"
    93                   (\<exists>f f'. t=lam x. f(x) \<and> t'=lam x. f'(x) \<and> (ALL x.<f(x),f'(x)> : R))"
    94 
    94 
    95 definition POgen :: "i set => i set"
    95 definition POgen :: "i set \<Rightarrow> i set"
    96   where "POgen(R) == {p. EX t t'. p=<t,t'> & (t = bot | SIM(t,t',R))}"
    96   where "POgen(R) == {p. \<exists>t t'. p=<t,t'> \<and> (t = bot | SIM(t,t',R))}"
    97 
    97 
    98 definition EQgen :: "i set => i set"
    98 definition EQgen :: "i set \<Rightarrow> i set"
    99   where "EQgen(R) == {p. EX t t'. p=<t,t'> & (t = bot & t' = bot | SIM(t,t',R))}"
    99   where "EQgen(R) == {p. \<exists>t t'. p=<t,t'> \<and> (t = bot \<and> t' = bot | SIM(t,t',R))}"
   100 
   100 
   101 definition PO :: "i set"
   101 definition PO :: "i set"
   102   where "PO == gfp(POgen)"
   102   where "PO == gfp(POgen)"
   103 
   103 
   104 definition EQ :: "i set"
   104 definition EQ :: "i set"
   109 
   109 
   110   (** Partial Order **)
   110   (** Partial Order **)
   111 
   111 
   112 axiomatization where
   112 axiomatization where
   113   po_refl:        "a [= a" and
   113   po_refl:        "a [= a" and
   114   po_trans:       "[| a [= b;  b [= c |] ==> a [= c" and
   114   po_trans:       "\<lbrakk>a [= b;  b [= c\<rbrakk> \<Longrightarrow> a [= c" and
   115   po_cong:        "a [= b ==> f(a) [= f(b)" and
   115   po_cong:        "a [= b \<Longrightarrow> f(a) [= f(b)" and
   116 
   116 
   117   (* Extend definition of [= to program fragments of higher type *)
   117   (* Extend definition of [= to program fragments of higher type *)
   118   po_abstractn:   "(!!x. f(x) [= g(x)) ==> (%x. f(x)) [= (%x. g(x))"
   118   po_abstractn:   "(\<And>x. f(x) [= g(x)) \<Longrightarrow> (\<lambda>x. f(x)) [= (\<lambda>x. g(x))"
   119 
   119 
   120   (** Equality - equivalence axioms inherited from FOL.thy   **)
   120   (** Equality - equivalence axioms inherited from FOL.thy   **)
   121   (**          - congruence of "=" is axiomatised implicitly **)
   121   (**          - congruence of "=" is axiomatised implicitly **)
   122 
   122 
   123 axiomatization where
   123 axiomatization where
   124   eq_iff:         "t = t' <-> t [= t' & t' [= t"
   124   eq_iff:         "t = t' \<longleftrightarrow> t [= t' \<and> t' [= t"
   125 
   125 
   126   (** Properties of canonical values given by greatest fixed point definitions **)
   126   (** Properties of canonical values given by greatest fixed point definitions **)
   127 
   127 
   128 axiomatization where
   128 axiomatization where
   129   PO_iff:         "t [= t' <-> <t,t'> : PO" and
   129   PO_iff:         "t [= t' \<longleftrightarrow> <t,t'> : PO" and
   130   EQ_iff:         "t =  t' <-> <t,t'> : EQ"
   130   EQ_iff:         "t =  t' \<longleftrightarrow> <t,t'> : EQ"
   131 
   131 
   132   (** Behaviour of non-canonical terms (ie case) given by the following beta-rules **)
   132   (** Behaviour of non-canonical terms (ie case) given by the following beta-rules **)
   133 
   133 
   134 axiomatization where
   134 axiomatization where
   135   caseBtrue:            "case(true,d,e,f,g) = d" and
   135   caseBtrue:            "case(true,d,e,f,g) = d" and
   138   caseBlam:       "\<And>b. case(lam x. b(x),d,e,f,g) = g(b)" and
   138   caseBlam:       "\<And>b. case(lam x. b(x),d,e,f,g) = g(b)" and
   139   caseBbot:              "case(bot,d,e,f,g) = bot"           (* strictness *)
   139   caseBbot:              "case(bot,d,e,f,g) = bot"           (* strictness *)
   140 
   140 
   141   (** The theory is non-trivial **)
   141   (** The theory is non-trivial **)
   142 axiomatization where
   142 axiomatization where
   143   distinctness:   "~ lam x. b(x) = bot"
   143   distinctness:   "\<not> lam x. b(x) = bot"
   144 
   144 
   145   (*** Definitions of Termination and Divergence ***)
   145   (*** Definitions of Termination and Divergence ***)
   146 
   146 
   147 definition Dvg :: "i => o"
   147 definition Dvg :: "i \<Rightarrow> o"
   148   where "Dvg(t) == t = bot"
   148   where "Dvg(t) == t = bot"
   149 
   149 
   150 definition Trm :: "i => o"
   150 definition Trm :: "i \<Rightarrow> o"
   151   where "Trm(t) == ~ Dvg(t)"
   151   where "Trm(t) == \<not> Dvg(t)"
   152 
   152 
   153 text {*
   153 text {*
   154 Would be interesting to build a similar theory for a typed programming language:
   154 Would be interesting to build a similar theory for a typed programming language:
   155     ie.     true :: bool,      fix :: ('a=>'a)=>'a  etc......
   155     ie.     true :: bool,      fix :: ('a\<Rightarrow>'a)\<Rightarrow>'a  etc......
   156 
   156 
   157 This is starting to look like LCF.
   157 This is starting to look like LCF.
   158 What are the advantages of this approach?
   158 What are the advantages of this approach?
   159         - less axiomatic
   159         - less axiomatic
   160         - wfd induction / coinduction and fixed point induction available
   160         - wfd induction / coinduction and fixed point induction available
   167 
   167 
   168 
   168 
   169 subsection {* Congruence Rules *}
   169 subsection {* Congruence Rules *}
   170 
   170 
   171 (*similar to AP_THM in Gordon's HOL*)
   171 (*similar to AP_THM in Gordon's HOL*)
   172 lemma fun_cong: "(f::'a=>'b) = g ==> f(x)=g(x)"
   172 lemma fun_cong: "(f::'a\<Rightarrow>'b) = g \<Longrightarrow> f(x)=g(x)"
   173   by simp
   173   by simp
   174 
   174 
   175 (*similar to AP_TERM in Gordon's HOL and FOL's subst_context*)
   175 (*similar to AP_TERM in Gordon's HOL and FOL's subst_context*)
   176 lemma arg_cong: "x=y ==> f(x)=f(y)"
   176 lemma arg_cong: "x=y \<Longrightarrow> f(x)=f(y)"
   177   by simp
   177   by simp
   178 
   178 
   179 lemma abstractn: "(!!x. f(x) = g(x)) ==> f = g"
   179 lemma abstractn: "(\<And>x. f(x) = g(x)) \<Longrightarrow> f = g"
   180   apply (simp add: eq_iff)
   180   apply (simp add: eq_iff)
   181   apply (blast intro: po_abstractn)
   181   apply (blast intro: po_abstractn)
   182   done
   182   done
   183 
   183 
   184 lemmas caseBs = caseBtrue caseBfalse caseBpair caseBlam caseBbot
   184 lemmas caseBs = caseBtrue caseBfalse caseBpair caseBlam caseBbot
   185 
   185 
   186 
   186 
   187 subsection {* Termination and Divergence *}
   187 subsection {* Termination and Divergence *}
   188 
   188 
   189 lemma Trm_iff: "Trm(t) <-> ~ t = bot"
   189 lemma Trm_iff: "Trm(t) \<longleftrightarrow> \<not> t = bot"
   190   by (simp add: Trm_def Dvg_def)
   190   by (simp add: Trm_def Dvg_def)
   191 
   191 
   192 lemma Dvg_iff: "Dvg(t) <-> t = bot"
   192 lemma Dvg_iff: "Dvg(t) \<longleftrightarrow> t = bot"
   193   by (simp add: Trm_def Dvg_def)
   193   by (simp add: Trm_def Dvg_def)
   194 
   194 
   195 
   195 
   196 subsection {* Constructors are injective *}
   196 subsection {* Constructors are injective *}
   197 
   197 
   198 lemma eq_lemma: "[| x=a;  y=b;  x=y |] ==> a=b"
   198 lemma eq_lemma: "\<lbrakk>x=a; y=b; x=y\<rbrakk> \<Longrightarrow> a=b"
   199   by simp
   199   by simp
   200 
   200 
   201 ML {*
   201 ML {*
   202   fun inj_rl_tac ctxt rews i =
   202   fun inj_rl_tac ctxt rews i =
   203     let
   203     let
   213 method_setup inj_rl = {*
   213 method_setup inj_rl = {*
   214   Attrib.thms >> (fn rews => fn ctxt => SIMPLE_METHOD' (inj_rl_tac ctxt rews))
   214   Attrib.thms >> (fn rews => fn ctxt => SIMPLE_METHOD' (inj_rl_tac ctxt rews))
   215 *}
   215 *}
   216 
   216 
   217 lemma ccl_injs:
   217 lemma ccl_injs:
   218   "<a,b> = <a',b'> <-> (a=a' & b=b')"
   218   "<a,b> = <a',b'> \<longleftrightarrow> (a=a' \<and> b=b')"
   219   "!!b b'. (lam x. b(x) = lam x. b'(x)) <-> ((ALL z. b(z)=b'(z)))"
   219   "\<And>b b'. (lam x. b(x) = lam x. b'(x)) \<longleftrightarrow> ((ALL z. b(z)=b'(z)))"
   220   by (inj_rl caseBs)
   220   by (inj_rl caseBs)
   221 
   221 
   222 
   222 
   223 lemma pair_inject: "<a,b> = <a',b'> \<Longrightarrow> (a = a' \<Longrightarrow> b = b' \<Longrightarrow> R) \<Longrightarrow> R"
   223 lemma pair_inject: "<a,b> = <a',b'> \<Longrightarrow> (a = a' \<Longrightarrow> b = b' \<Longrightarrow> R) \<Longrightarrow> R"
   224   by (simp add: ccl_injs)
   224   by (simp add: ccl_injs)
   225 
   225 
   226 
   226 
   227 subsection {* Constructors are distinct *}
   227 subsection {* Constructors are distinct *}
   228 
   228 
   229 lemma lem: "t=t' ==> case(t,b,c,d,e) = case(t',b,c,d,e)"
   229 lemma lem: "t=t' \<Longrightarrow> case(t,b,c,d,e) = case(t',b,c,d,e)"
   230   by simp
   230   by simp
   231 
   231 
   232 ML {*
   232 ML {*
   233 local
   233 local
   234   fun pairs_of f x [] = []
   234   fun pairs_of f x [] = []
   244          | arg_str n a s = arg_str (n-1) a ("," ^ a ^ (chr((ord "a")+n-1)) ^ s)
   244          | arg_str n a s = arg_str (n-1) a ("," ^ a ^ (chr((ord "a")+n-1)) ^ s)
   245            val T = Sign.the_const_type thy (Sign.intern_const thy sy);
   245            val T = Sign.the_const_type thy (Sign.intern_const thy sy);
   246            val arity = length (binder_types T)
   246            val arity = length (binder_types T)
   247        in sy ^ (arg_str arity name "") end
   247        in sy ^ (arg_str arity name "") end
   248 
   248 
   249   fun mk_thm_str thy a b = "~ " ^ (saturate thy a "a") ^ " = " ^ (saturate thy b "b")
   249   fun mk_thm_str thy a b = "\<not> " ^ (saturate thy a "a") ^ " = " ^ (saturate thy b "b")
   250 
   250 
   251   val lemma = @{thm lem};
   251   val lemma = @{thm lem};
   252   val eq_lemma = @{thm eq_lemma};
   252   val eq_lemma = @{thm eq_lemma};
   253   val distinctness = @{thm distinctness};
   253   val distinctness = @{thm distinctness};
   254   fun mk_lemma (ra,rb) =
   254   fun mk_lemma (ra,rb) =
   265 
   265 
   266 val ccl_dstncts =
   266 val ccl_dstncts =
   267   let
   267   let
   268     fun mk_raw_dstnct_thm rls s =
   268     fun mk_raw_dstnct_thm rls s =
   269       Goal.prove_global @{theory} [] [] (Syntax.read_prop_global @{theory} s)
   269       Goal.prove_global @{theory} [] [] (Syntax.read_prop_global @{theory} s)
   270         (fn _=> rtac @{thm notI} 1 THEN eresolve_tac rls 1)
   270         (fn _ => rtac @{thm notI} 1 THEN eresolve_tac rls 1)
   271   in map (mk_raw_dstnct_thm caseB_lemmas)
   271   in map (mk_raw_dstnct_thm caseB_lemmas)
   272     (mk_dstnct_rls @{theory} ["bot","true","false","pair","lambda"]) end
   272     (mk_dstnct_rls @{theory} ["bot","true","false","pair","lambda"]) end
   273 
   273 
   274 fun mk_dstnct_thms ctxt defs inj_rls xs =
   274 fun mk_dstnct_thms ctxt defs inj_rls xs =
   275   let
   275   let
   302   and [dest!] = ccl_injDs
   302   and [dest!] = ccl_injDs
   303 
   303 
   304 
   304 
   305 subsection {* Facts from gfp Definition of @{text "[="} and @{text "="} *}
   305 subsection {* Facts from gfp Definition of @{text "[="} and @{text "="} *}
   306 
   306 
   307 lemma XHlemma1: "[| A=B;  a:B <-> P |] ==> a:A <-> P"
   307 lemma XHlemma1: "\<lbrakk>A=B; a:B \<longleftrightarrow> P\<rbrakk> \<Longrightarrow> a:A \<longleftrightarrow> P"
   308   by simp
   308   by simp
   309 
   309 
   310 lemma XHlemma2: "(P(t,t') <-> Q) ==> (<t,t'> : {p. EX t t'. p=<t,t'> &  P(t,t')} <-> Q)"
   310 lemma XHlemma2: "(P(t,t') \<longleftrightarrow> Q) \<Longrightarrow> (<t,t'> : {p. \<exists>t t'. p=<t,t'> \<and>  P(t,t')} \<longleftrightarrow> Q)"
   311   by blast
   311   by blast
   312 
   312 
   313 
   313 
   314 subsection {* Pre-Order *}
   314 subsection {* Pre-Order *}
   315 
   315 
   316 lemma POgen_mono: "mono(%X. POgen(X))"
   316 lemma POgen_mono: "mono(\<lambda>X. POgen(X))"
   317   apply (unfold POgen_def SIM_def)
   317   apply (unfold POgen_def SIM_def)
   318   apply (rule monoI)
   318   apply (rule monoI)
   319   apply blast
   319   apply blast
   320   done
   320   done
   321 
   321 
   322 lemma POgenXH: 
   322 lemma POgenXH: 
   323   "<t,t'> : POgen(R) <-> t= bot | (t=true & t'=true)  | (t=false & t'=false) |  
   323   "<t,t'> : POgen(R) \<longleftrightarrow> t= bot | (t=true \<and> t'=true)  | (t=false \<and> t'=false) |  
   324            (EX a a' b b'. t=<a,b> &  t'=<a',b'>  & <a,a'> : R & <b,b'> : R) |  
   324            (EX a a' b b'. t=<a,b> \<and> t'=<a',b'>  \<and> <a,a'> : R \<and> <b,b'> : R) |  
   325            (EX f f'. t=lam x. f(x) &  t'=lam x. f'(x) & (ALL x. <f(x),f'(x)> : R))"
   325            (EX f f'. t=lam x. f(x) \<and> t'=lam x. f'(x) \<and> (ALL x. <f(x),f'(x)> : R))"
   326   apply (unfold POgen_def SIM_def)
   326   apply (unfold POgen_def SIM_def)
   327   apply (rule iff_refl [THEN XHlemma2])
   327   apply (rule iff_refl [THEN XHlemma2])
   328   done
   328   done
   329 
   329 
   330 lemma poXH: 
   330 lemma poXH: 
   331   "t [= t' <-> t=bot | (t=true & t'=true) | (t=false & t'=false) |  
   331   "t [= t' \<longleftrightarrow> t=bot | (t=true \<and> t'=true) | (t=false \<and> t'=false) |  
   332                  (EX a a' b b'. t=<a,b> &  t'=<a',b'>  & a [= a' & b [= b') |  
   332                  (EX a a' b b'. t=<a,b> \<and> t'=<a',b'>  \<and> a [= a' \<and> b [= b') |  
   333                  (EX f f'. t=lam x. f(x) &  t'=lam x. f'(x) & (ALL x. f(x) [= f'(x)))"
   333                  (EX f f'. t=lam x. f(x) \<and> t'=lam x. f'(x) \<and> (ALL x. f(x) [= f'(x)))"
   334   apply (simp add: PO_iff del: ex_simps)
   334   apply (simp add: PO_iff del: ex_simps)
   335   apply (rule POgen_mono
   335   apply (rule POgen_mono
   336     [THEN PO_def [THEN def_gfp_Tarski], THEN XHlemma1, unfolded POgen_def SIM_def])
   336     [THEN PO_def [THEN def_gfp_Tarski], THEN XHlemma1, unfolded POgen_def SIM_def])
   337   apply (rule iff_refl [THEN XHlemma2])
   337   apply (rule iff_refl [THEN XHlemma2])
   338   done
   338   done
   340 lemma po_bot: "bot [= b"
   340 lemma po_bot: "bot [= b"
   341   apply (rule poXH [THEN iffD2])
   341   apply (rule poXH [THEN iffD2])
   342   apply simp
   342   apply simp
   343   done
   343   done
   344 
   344 
   345 lemma bot_poleast: "a [= bot ==> a=bot"
   345 lemma bot_poleast: "a [= bot \<Longrightarrow> a=bot"
   346   apply (drule poXH [THEN iffD1])
   346   apply (drule poXH [THEN iffD1])
   347   apply simp
   347   apply simp
   348   done
   348   done
   349 
   349 
   350 lemma po_pair: "<a,b> [= <a',b'> <->  a [= a' & b [= b'"
   350 lemma po_pair: "<a,b> [= <a',b'> \<longleftrightarrow>  a [= a' \<and> b [= b'"
   351   apply (rule poXH [THEN iff_trans])
   351   apply (rule poXH [THEN iff_trans])
   352   apply simp
   352   apply simp
   353   done
   353   done
   354 
   354 
   355 lemma po_lam: "lam x. f(x) [= lam x. f'(x) <-> (ALL x. f(x) [= f'(x))"
   355 lemma po_lam: "lam x. f(x) [= lam x. f'(x) \<longleftrightarrow> (ALL x. f(x) [= f'(x))"
   356   apply (rule poXH [THEN iff_trans])
   356   apply (rule poXH [THEN iff_trans])
   357   apply fastforce
   357   apply fastforce
   358   done
   358   done
   359 
   359 
   360 lemmas ccl_porews = po_bot po_pair po_lam
   360 lemmas ccl_porews = po_bot po_pair po_lam
   361 
   361 
   362 lemma case_pocong:
   362 lemma case_pocong:
   363   assumes 1: "t [= t'"
   363   assumes 1: "t [= t'"
   364     and 2: "a [= a'"
   364     and 2: "a [= a'"
   365     and 3: "b [= b'"
   365     and 3: "b [= b'"
   366     and 4: "!!x y. c(x,y) [= c'(x,y)"
   366     and 4: "\<And>x y. c(x,y) [= c'(x,y)"
   367     and 5: "!!u. d(u) [= d'(u)"
   367     and 5: "\<And>u. d(u) [= d'(u)"
   368   shows "case(t,a,b,c,d) [= case(t',a',b',c',d')"
   368   shows "case(t,a,b,c,d) [= case(t',a',b',c',d')"
   369   apply (rule 1 [THEN po_cong, THEN po_trans])
   369   apply (rule 1 [THEN po_cong, THEN po_trans])
   370   apply (rule 2 [THEN po_cong, THEN po_trans])
   370   apply (rule 2 [THEN po_cong, THEN po_trans])
   371   apply (rule 3 [THEN po_cong, THEN po_trans])
   371   apply (rule 3 [THEN po_cong, THEN po_trans])
   372   apply (rule 4 [THEN po_abstractn, THEN po_abstractn, THEN po_cong, THEN po_trans])
   372   apply (rule 4 [THEN po_abstractn, THEN po_abstractn, THEN po_cong, THEN po_trans])
   373   apply (rule_tac f1 = "%d. case (t',a',b',c',d)" in
   373   apply (rule_tac f1 = "\<lambda>d. case (t',a',b',c',d)" in
   374     5 [THEN po_abstractn, THEN po_cong, THEN po_trans])
   374     5 [THEN po_abstractn, THEN po_cong, THEN po_trans])
   375   apply (rule po_refl)
   375   apply (rule po_refl)
   376   done
   376   done
   377 
   377 
   378 lemma apply_pocong: "[| f [= f';  a [= a' |] ==> f ` a [= f' ` a'"
   378 lemma apply_pocong: "\<lbrakk>f [= f'; a [= a'\<rbrakk> \<Longrightarrow> f ` a [= f' ` a'"
   379   unfolding ccl_data_defs
   379   unfolding ccl_data_defs
   380   apply (rule case_pocong, (rule po_refl | assumption)+)
   380   apply (rule case_pocong, (rule po_refl | assumption)+)
   381   apply (erule po_cong)
   381   apply (erule po_cong)
   382   done
   382   done
   383 
   383 
   384 lemma npo_lam_bot: "~ lam x. b(x) [= bot"
   384 lemma npo_lam_bot: "\<not> lam x. b(x) [= bot"
   385   apply (rule notI)
   385   apply (rule notI)
   386   apply (drule bot_poleast)
   386   apply (drule bot_poleast)
   387   apply (erule distinctness [THEN notE])
   387   apply (erule distinctness [THEN notE])
   388   done
   388   done
   389 
   389 
   390 lemma po_lemma: "[| x=a;  y=b;  x[=y |] ==> a[=b"
   390 lemma po_lemma: "\<lbrakk>x=a; y=b; x[=y\<rbrakk> \<Longrightarrow> a[=b"
   391   by simp
   391   by simp
   392 
   392 
   393 lemma npo_pair_lam: "~ <a,b> [= lam x. f(x)"
   393 lemma npo_pair_lam: "\<not> <a,b> [= lam x. f(x)"
   394   apply (rule notI)
   394   apply (rule notI)
   395   apply (rule npo_lam_bot [THEN notE])
   395   apply (rule npo_lam_bot [THEN notE])
   396   apply (erule case_pocong [THEN caseBlam [THEN caseBpair [THEN po_lemma]]])
   396   apply (erule case_pocong [THEN caseBlam [THEN caseBpair [THEN po_lemma]]])
   397   apply (rule po_refl npo_lam_bot)+
   397   apply (rule po_refl npo_lam_bot)+
   398   done
   398   done
   399 
   399 
   400 lemma npo_lam_pair: "~ lam x. f(x) [= <a,b>"
   400 lemma npo_lam_pair: "\<not> lam x. f(x) [= <a,b>"
   401   apply (rule notI)
   401   apply (rule notI)
   402   apply (rule npo_lam_bot [THEN notE])
   402   apply (rule npo_lam_bot [THEN notE])
   403   apply (erule case_pocong [THEN caseBpair [THEN caseBlam [THEN po_lemma]]])
   403   apply (erule case_pocong [THEN caseBpair [THEN caseBlam [THEN po_lemma]]])
   404   apply (rule po_refl npo_lam_bot)+
   404   apply (rule po_refl npo_lam_bot)+
   405   done
   405   done
   406 
   406 
   407 lemma npo_rls1:
   407 lemma npo_rls1:
   408   "~ true [= false"
   408   "\<not> true [= false"
   409   "~ false [= true"
   409   "\<not> false [= true"
   410   "~ true [= <a,b>"
   410   "\<not> true [= <a,b>"
   411   "~ <a,b> [= true"
   411   "\<not> <a,b> [= true"
   412   "~ true [= lam x. f(x)"
   412   "\<not> true [= lam x. f(x)"
   413   "~ lam x. f(x) [= true"
   413   "\<not> lam x. f(x) [= true"
   414   "~ false [= <a,b>"
   414   "\<not> false [= <a,b>"
   415   "~ <a,b> [= false"
   415   "\<not> <a,b> [= false"
   416   "~ false [= lam x. f(x)"
   416   "\<not> false [= lam x. f(x)"
   417   "~ lam x. f(x) [= false"
   417   "\<not> lam x. f(x) [= false"
   418   by (rule notI, drule case_pocong, erule_tac [5] rev_mp, simp_all,
   418   by (rule notI, drule case_pocong, erule_tac [5] rev_mp, simp_all,
   419     (rule po_refl npo_lam_bot)+)+
   419     (rule po_refl npo_lam_bot)+)+
   420 
   420 
   421 lemmas npo_rls = npo_pair_lam npo_lam_pair npo_rls1
   421 lemmas npo_rls = npo_pair_lam npo_lam_pair npo_rls1
   422 
   422 
   423 
   423 
   424 subsection {* Coinduction for @{text "[="} *}
   424 subsection {* Coinduction for @{text "[="} *}
   425 
   425 
   426 lemma po_coinduct: "[|  <t,u> : R;  R <= POgen(R) |] ==> t [= u"
   426 lemma po_coinduct: "\<lbrakk><t,u> : R; R <= POgen(R)\<rbrakk> \<Longrightarrow> t [= u"
   427   apply (rule PO_def [THEN def_coinduct, THEN PO_iff [THEN iffD2]])
   427   apply (rule PO_def [THEN def_coinduct, THEN PO_iff [THEN iffD2]])
   428    apply assumption+
   428    apply assumption+
   429   done
   429   done
   430 
   430 
   431 
   431 
   432 subsection {* Equality *}
   432 subsection {* Equality *}
   433 
   433 
   434 lemma EQgen_mono: "mono(%X. EQgen(X))"
   434 lemma EQgen_mono: "mono(\<lambda>X. EQgen(X))"
   435   apply (unfold EQgen_def SIM_def)
   435   apply (unfold EQgen_def SIM_def)
   436   apply (rule monoI)
   436   apply (rule monoI)
   437   apply blast
   437   apply blast
   438   done
   438   done
   439 
   439 
   440 lemma EQgenXH: 
   440 lemma EQgenXH: 
   441   "<t,t'> : EQgen(R) <-> (t=bot & t'=bot)  | (t=true & t'=true)  |  
   441   "<t,t'> : EQgen(R) \<longleftrightarrow> (t=bot \<and> t'=bot)  | (t=true \<and> t'=true)  |  
   442                                              (t=false & t'=false) |  
   442                                              (t=false \<and> t'=false) |  
   443                  (EX a a' b b'. t=<a,b> &  t'=<a',b'>  & <a,a'> : R & <b,b'> : R) |  
   443                  (EX a a' b b'. t=<a,b> \<and> t'=<a',b'>  \<and> <a,a'> : R \<and> <b,b'> : R) |  
   444                  (EX f f'. t=lam x. f(x) &  t'=lam x. f'(x) & (ALL x.<f(x),f'(x)> : R))"
   444                  (EX f f'. t=lam x. f(x) \<and> t'=lam x. f'(x) \<and> (ALL x.<f(x),f'(x)> : R))"
   445   apply (unfold EQgen_def SIM_def)
   445   apply (unfold EQgen_def SIM_def)
   446   apply (rule iff_refl [THEN XHlemma2])
   446   apply (rule iff_refl [THEN XHlemma2])
   447   done
   447   done
   448 
   448 
   449 lemma eqXH: 
   449 lemma eqXH: 
   450   "t=t' <-> (t=bot & t'=bot)  | (t=true & t'=true)  | (t=false & t'=false) |  
   450   "t=t' \<longleftrightarrow> (t=bot \<and> t'=bot)  | (t=true \<and> t'=true)  | (t=false \<and> t'=false) |  
   451                      (EX a a' b b'. t=<a,b> &  t'=<a',b'>  & a=a' & b=b') |  
   451                      (EX a a' b b'. t=<a,b> \<and> t'=<a',b'>  \<and> a=a' \<and> b=b') |  
   452                      (EX f f'. t=lam x. f(x) &  t'=lam x. f'(x) & (ALL x. f(x)=f'(x)))"
   452                      (EX f f'. t=lam x. f(x) \<and> t'=lam x. f'(x) \<and> (ALL x. f(x)=f'(x)))"
   453   apply (subgoal_tac "<t,t'> : EQ <-> (t=bot & t'=bot) | (t=true & t'=true) | (t=false & t'=false) | (EX a a' b b'. t=<a,b> & t'=<a',b'> & <a,a'> : EQ & <b,b'> : EQ) | (EX f f'. t=lam x. f (x) & t'=lam x. f' (x) & (ALL x. <f (x) ,f' (x) > : EQ))")
   453   apply (subgoal_tac "<t,t'> : EQ \<longleftrightarrow>
       
   454     (t=bot \<and> t'=bot) | (t=true \<and> t'=true) | (t=false \<and> t'=false) |
       
   455     (EX a a' b b'. t=<a,b> \<and> t'=<a',b'> \<and> <a,a'> : EQ \<and> <b,b'> : EQ) |
       
   456     (EX f f'. t=lam x. f (x) \<and> t'=lam x. f' (x) \<and> (ALL x. <f (x) ,f' (x) > : EQ))")
   454   apply (erule rev_mp)
   457   apply (erule rev_mp)
   455   apply (simp add: EQ_iff [THEN iff_sym])
   458   apply (simp add: EQ_iff [THEN iff_sym])
   456   apply (rule EQgen_mono [THEN EQ_def [THEN def_gfp_Tarski], THEN XHlemma1,
   459   apply (rule EQgen_mono [THEN EQ_def [THEN def_gfp_Tarski], THEN XHlemma1,
   457     unfolded EQgen_def SIM_def])
   460     unfolded EQgen_def SIM_def])
   458   apply (rule iff_refl [THEN XHlemma2])
   461   apply (rule iff_refl [THEN XHlemma2])
   459   done
   462   done
   460 
   463 
   461 lemma eq_coinduct: "[|  <t,u> : R;  R <= EQgen(R) |] ==> t = u"
   464 lemma eq_coinduct: "\<lbrakk><t,u> : R; R <= EQgen(R)\<rbrakk> \<Longrightarrow> t = u"
   462   apply (rule EQ_def [THEN def_coinduct, THEN EQ_iff [THEN iffD2]])
   465   apply (rule EQ_def [THEN def_coinduct, THEN EQ_iff [THEN iffD2]])
   463    apply assumption+
   466    apply assumption+
   464   done
   467   done
   465 
   468 
   466 lemma eq_coinduct3:
   469 lemma eq_coinduct3:
   467   "[|  <t,u> : R;  R <= EQgen(lfp(%x. EQgen(x) Un R Un EQ)) |] ==> t = u"
   470   "\<lbrakk><t,u> : R;  R <= EQgen(lfp(\<lambda>x. EQgen(x) Un R Un EQ))\<rbrakk> \<Longrightarrow> t = u"
   468   apply (rule EQ_def [THEN def_coinduct3, THEN EQ_iff [THEN iffD2]])
   471   apply (rule EQ_def [THEN def_coinduct3, THEN EQ_iff [THEN iffD2]])
   469   apply (rule EQgen_mono | assumption)+
   472   apply (rule EQgen_mono | assumption)+
   470   done
   473   done
   471 
   474 
   472 method_setup eq_coinduct3 = {*
   475 method_setup eq_coinduct3 = {*
   475 *}
   478 *}
   476 
   479 
   477 
   480 
   478 subsection {* Untyped Case Analysis and Other Facts *}
   481 subsection {* Untyped Case Analysis and Other Facts *}
   479 
   482 
   480 lemma cond_eta: "(EX f. t=lam x. f(x)) ==> t = lam x.(t ` x)"
   483 lemma cond_eta: "(EX f. t=lam x. f(x)) \<Longrightarrow> t = lam x.(t ` x)"
   481   by (auto simp: apply_def)
   484   by (auto simp: apply_def)
   482 
   485 
   483 lemma exhaustion: "(t=bot) | (t=true) | (t=false) | (EX a b. t=<a,b>) | (EX f. t=lam x. f(x))"
   486 lemma exhaustion: "(t=bot) | (t=true) | (t=false) | (EX a b. t=<a,b>) | (EX f. t=lam x. f(x))"
   484   apply (cut_tac refl [THEN eqXH [THEN iffD1]])
   487   apply (cut_tac refl [THEN eqXH [THEN iffD1]])
   485   apply blast
   488   apply blast
   486   done
   489   done
   487 
   490 
   488 lemma term_case:
   491 lemma term_case:
   489   "[| P(bot);  P(true);  P(false);  !!x y. P(<x,y>);  !!b. P(lam x. b(x)) |] ==> P(t)"
   492   "\<lbrakk>P(bot); P(true); P(false); \<And>x y. P(<x,y>); \<And>b. P(lam x. b(x))\<rbrakk> \<Longrightarrow> P(t)"
   490   using exhaustion [of t] by blast
   493   using exhaustion [of t] by blast
   491 
   494 
   492 end
   495 end