| author | wenzelm | 
| Wed, 06 Aug 1997 14:42:44 +0200 | |
| changeset 3631 | 88a279998f90 | 
| parent 297 | 5ef75ff3baeb | 
| permissions | -rw-r--r-- | 
| 243 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 1 | (* Title: HOLCF/stream.ML | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 2 | ID: $Id$ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 3 | Author: Franz Regensburger | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 4 | Copyright 1993 Technische Universitaet Muenchen | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 5 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 6 | Lemmas for stream.thy | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 7 | *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 8 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 9 | open Stream; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 10 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 11 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 12 | (* The isomorphisms stream_rep_iso and stream_abs_iso are strict *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 13 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 14 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 15 | val stream_iso_strict= stream_rep_iso RS (stream_abs_iso RS | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 16 | (allI RSN (2,allI RS iso_strict))); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 17 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 18 | val stream_rews = [stream_iso_strict RS conjunct1, | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 19 | stream_iso_strict RS conjunct2]; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 20 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 21 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 22 | (* Properties of stream_copy *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 23 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 24 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 25 | fun prover defs thm = prove_goalw Stream.thy defs thm | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 26 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 27 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 28 | (cut_facts_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 29 | (asm_simp_tac (HOLCF_ss addsimps | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 30 | (stream_rews @ [stream_abs_iso,stream_rep_iso])) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 31 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 32 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 33 | val stream_copy = | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 34 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 35 | prover [stream_copy_def] "stream_copy[f][UU]=UU", | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 36 | prover [stream_copy_def,scons_def] | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 37 | "x~=UU ==> stream_copy[f][scons[x][xs]]= scons[x][f[xs]]" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 38 | ]; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 39 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 40 | val stream_rews = stream_copy @ stream_rews; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 41 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 42 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 43 | (* Exhaustion and elimination for streams *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 44 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 45 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 46 | val Exh_stream = prove_goalw Stream.thy [scons_def] | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 47 | "s = UU | (? x xs. x~=UU & s = scons[x][xs])" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 48 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 49 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 50 | (simp_tac HOLCF_ss 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 51 | (rtac (stream_rep_iso RS subst) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 52 | 	(res_inst_tac [("p","stream_rep[s]")] sprodE 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 53 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 54 | (asm_simp_tac HOLCF_ss 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 55 | 	(res_inst_tac [("p","y")] liftE1 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 56 | (contr_tac 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 57 | (rtac disjI2 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 58 | (rtac exI 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 59 | (rtac exI 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 60 | (etac conjI 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 61 | (asm_simp_tac HOLCF_ss 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 62 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 63 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 64 | val streamE = prove_goal Stream.thy | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 65 | "[| s=UU ==> Q; !!x xs.[|s=scons[x][xs];x~=UU|]==>Q|]==>Q" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 66 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 67 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 68 | (rtac (Exh_stream RS disjE) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 69 | (eresolve_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 70 | (etac exE 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 71 | (etac exE 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 72 | (resolve_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 73 | (fast_tac HOL_cs 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 74 | (fast_tac HOL_cs 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 75 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 76 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 77 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 78 | (* Properties of stream_when *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 79 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 80 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 81 | fun prover defs thm = prove_goalw Stream.thy defs thm | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 82 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 83 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 84 | (cut_facts_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 85 | (asm_simp_tac (HOLCF_ss addsimps | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 86 | (stream_rews @ [stream_abs_iso,stream_rep_iso])) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 87 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 88 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 89 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 90 | val stream_when = [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 91 | prover [stream_when_def] "stream_when[f][UU]=UU", | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 92 | prover [stream_when_def,scons_def] | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 93 | "x~=UU ==> stream_when[f][scons[x][xs]]= f[x][xs]" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 94 | ]; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 95 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 96 | val stream_rews = stream_when @ stream_rews; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 97 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 98 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 99 | (* Rewrites for discriminators and selectors *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 100 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 101 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 102 | fun prover defs thm = prove_goalw Stream.thy defs thm | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 103 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 104 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 105 | (simp_tac (HOLCF_ss addsimps stream_rews) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 106 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 107 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 108 | val stream_discsel = [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 109 | prover [is_scons_def] "is_scons[UU]=UU", | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 110 | prover [shd_def] "shd[UU]=UU", | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 111 | prover [stl_def] "stl[UU]=UU" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 112 | ]; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 113 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 114 | fun prover defs thm = prove_goalw Stream.thy defs thm | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 115 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 116 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 117 | (cut_facts_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 118 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 119 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 120 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 121 | val stream_discsel = [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 122 | prover [is_scons_def,shd_def,stl_def] "x~=UU ==> is_scons[scons[x][xs]]=TT", | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 123 | prover [is_scons_def,shd_def,stl_def] "x~=UU ==> shd[scons[x][xs]]=x", | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 124 | prover [is_scons_def,shd_def,stl_def] "x~=UU ==> stl[scons[x][xs]]=xs" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 125 | ] @ stream_discsel; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 126 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 127 | val stream_rews = stream_discsel @ stream_rews; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 128 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 129 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 130 | (* Definedness and strictness *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 131 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 132 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 133 | fun prover contr thm = prove_goal Stream.thy thm | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 134 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 135 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 136 | 	(res_inst_tac [("P1",contr)] classical3 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 137 | (simp_tac (HOLCF_ss addsimps stream_rews) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 138 | (dtac sym 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 139 | (asm_simp_tac HOLCF_ss 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 140 | (simp_tac (HOLCF_ss addsimps (prems @ stream_rews)) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 141 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 142 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 143 | val stream_constrdef = [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 144 | prover "is_scons[UU] ~= UU" "x~=UU ==> scons[x][xs]~=UU" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 145 | ]; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 146 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 147 | fun prover defs thm = prove_goalw Stream.thy defs thm | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 148 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 149 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 150 | (simp_tac (HOLCF_ss addsimps stream_rews) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 151 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 152 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 153 | val stream_constrdef = [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 154 | prover [scons_def] "scons[UU][xs]=UU" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 155 | ] @ stream_constrdef; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 156 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 157 | val stream_rews = stream_constrdef @ stream_rews; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 158 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 159 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 160 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 161 | (* Distinctness wrt. << and = *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 162 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 163 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 164 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 165 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 166 | (* Invertibility *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 167 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 168 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 169 | val stream_invert = | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 170 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 171 | prove_goal Stream.thy "[|x1~=UU; y1~=UU;\ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 172 | \ scons[x1][x2] << scons[y1][y2]|] ==> x1<< y1 & x2 << y2" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 173 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 174 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 175 | (cut_facts_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 176 | (rtac conjI 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 177 | 	(dres_inst_tac [("fo5","stream_when[LAM x l.x]")] monofun_cfun_arg 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 178 | (etac box_less 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 179 | (asm_simp_tac (HOLCF_ss addsimps stream_when) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 180 | (asm_simp_tac (HOLCF_ss addsimps stream_when) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 181 | 	(dres_inst_tac [("fo5","stream_when[LAM x l.l]")] monofun_cfun_arg 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 182 | (etac box_less 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 183 | (asm_simp_tac (HOLCF_ss addsimps stream_when) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 184 | (asm_simp_tac (HOLCF_ss addsimps stream_when) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 185 | ]) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 186 | ]; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 187 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 188 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 189 | (* Injectivity *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 190 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 191 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 192 | val stream_inject = | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 193 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 194 | prove_goal Stream.thy "[|x1~=UU; y1~=UU;\ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 195 | \ scons[x1][x2] = scons[y1][y2]|] ==> x1= y1 & x2 = y2" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 196 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 197 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 198 | (cut_facts_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 199 | (rtac conjI 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 200 | 	(dres_inst_tac [("f","stream_when[LAM x l.x]")] cfun_arg_cong 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 201 | (etac box_equals 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 202 | (asm_simp_tac (HOLCF_ss addsimps stream_when) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 203 | (asm_simp_tac (HOLCF_ss addsimps stream_when) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 204 | 	(dres_inst_tac [("f","stream_when[LAM x l.l]")] cfun_arg_cong 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 205 | (etac box_equals 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 206 | (asm_simp_tac (HOLCF_ss addsimps stream_when) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 207 | (asm_simp_tac (HOLCF_ss addsimps stream_when) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 208 | ]) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 209 | ]; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 210 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 211 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 212 | (* definedness for discriminators and selectors *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 213 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 214 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 215 | fun prover thm = prove_goal Stream.thy thm | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 216 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 217 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 218 | (cut_facts_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 219 | (rtac streamE 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 220 | (contr_tac 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 221 | (REPEAT (asm_simp_tac (HOLCF_ss addsimps stream_discsel) 1)) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 222 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 223 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 224 | val stream_discsel_def = | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 225 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 226 | prover "s~=UU ==> is_scons[s]~=UU", | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 227 | prover "s~=UU ==> shd[s]~=UU" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 228 | ]; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 229 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 230 | val stream_rews = stream_discsel_def @ stream_rews; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 231 | |
| 297 | 232 | |
| 243 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 233 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 234 | (* Properties stream_take *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 235 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 236 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 237 | val stream_take = | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 238 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 239 | prove_goalw Stream.thy [stream_take_def] "stream_take(n)[UU]=UU" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 240 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 241 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 242 | 	(res_inst_tac [("n","n")] natE 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 243 | (asm_simp_tac iterate_ss 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 244 | (asm_simp_tac iterate_ss 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 245 | (simp_tac (HOLCF_ss addsimps stream_rews) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 246 | ]), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 247 | prove_goalw Stream.thy [stream_take_def] "stream_take(0)[xs]=UU" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 248 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 249 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 250 | (asm_simp_tac iterate_ss 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 251 | ])]; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 252 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 253 | fun prover thm = prove_goalw Stream.thy [stream_take_def] thm | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 254 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 255 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 256 | (cut_facts_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 257 | (simp_tac iterate_ss 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 258 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 259 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 260 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 261 | val stream_take = [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 262 | prover | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 263 | "x~=UU ==> stream_take(Suc(n))[scons[x][xs]]=scons[x][stream_take(n)[xs]]" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 264 | ] @ stream_take; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 265 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 266 | val stream_rews = stream_take @ stream_rews; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 267 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 268 | (* ------------------------------------------------------------------------*) | 
| 297 | 269 | (* enhance the simplifier *) | 
| 270 | (* ------------------------------------------------------------------------*) | |
| 271 | ||
| 272 | val stream_copy2 = prove_goal Stream.thy | |
| 273 | "stream_copy[f][scons[x][xs]]= scons[x][f[xs]]" | |
| 274 | (fn prems => | |
| 275 | [ | |
| 276 | 	(res_inst_tac [("Q","x=UU")] classical2 1),
 | |
| 277 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 278 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1) | |
| 279 | ]); | |
| 280 | ||
| 281 | val shd2 = prove_goal Stream.thy "shd[scons[x][xs]]=x" | |
| 282 | (fn prems => | |
| 283 | [ | |
| 284 | 	(res_inst_tac [("Q","x=UU")] classical2 1),
 | |
| 285 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 286 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1) | |
| 287 | ]); | |
| 288 | ||
| 289 | val stream_take2 = prove_goal Stream.thy | |
| 290 | "stream_take(Suc(n))[scons[x][xs]]=scons[x][stream_take(n)[xs]]" | |
| 291 | (fn prems => | |
| 292 | [ | |
| 293 | 	(res_inst_tac [("Q","x=UU")] classical2 1),
 | |
| 294 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 295 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1) | |
| 296 | ]); | |
| 297 | ||
| 298 | val stream_rews = [stream_iso_strict RS conjunct1, | |
| 299 | stream_iso_strict RS conjunct2, | |
| 300 | hd stream_copy, stream_copy2] | |
| 301 | @ stream_when | |
| 302 | @ [hd stream_discsel,shd2] @ (tl (tl stream_discsel)) | |
| 303 | @ stream_constrdef | |
| 304 | @ stream_discsel_def | |
| 305 | @ [ stream_take2] @ (tl stream_take); | |
| 306 | ||
| 307 | ||
| 308 | (* ------------------------------------------------------------------------*) | |
| 243 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 309 | (* take lemma for streams *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 310 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 311 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 312 | fun prover reach defs thm = prove_goalw Stream.thy defs thm | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 313 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 314 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 315 | 	(res_inst_tac [("t","s1")] (reach RS subst) 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 316 | 	(res_inst_tac [("t","s2")] (reach RS subst) 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 317 | (rtac (fix_def2 RS ssubst) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 318 | (rtac (contlub_cfun_fun RS ssubst) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 319 | (rtac is_chain_iterate 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 320 | (rtac (contlub_cfun_fun RS ssubst) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 321 | (rtac is_chain_iterate 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 322 | (rtac lub_equal 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 323 | (rtac (is_chain_iterate RS ch2ch_fappL) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 324 | (rtac (is_chain_iterate RS ch2ch_fappL) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 325 | (rtac allI 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 326 | (resolve_tac prems 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 327 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 328 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 329 | val stream_take_lemma = prover stream_reach [stream_take_def] | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 330 | "(!!n.stream_take(n)[s1]=stream_take(n)[s2]) ==> s1=s2"; | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 331 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 332 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 333 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 334 | (* Co -induction for streams *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 335 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 336 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 337 | val stream_coind_lemma = prove_goalw Stream.thy [stream_bisim_def] | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 338 | "stream_bisim(R) ==> ! p q.R(p,q) --> stream_take(n)[p]=stream_take(n)[q]" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 339 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 340 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 341 | (cut_facts_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 342 | (nat_ind_tac "n" 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 343 | (simp_tac (HOLCF_ss addsimps stream_rews) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 344 | (strip_tac 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 345 | ((etac allE 1) THEN (etac allE 1) THEN (etac (mp RS disjE) 1)), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 346 | (atac 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 347 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 348 | (etac exE 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 349 | (etac exE 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 350 | (etac exE 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 351 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 352 | (REPEAT (etac conjE 1)), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 353 | (rtac cfun_arg_cong 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 354 | (fast_tac HOL_cs 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 355 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 356 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 357 | val stream_coind = prove_goal Stream.thy "[|stream_bisim(R);R(p,q)|] ==> p = q" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 358 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 359 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 360 | (rtac stream_take_lemma 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 361 | (rtac (stream_coind_lemma RS spec RS spec RS mp) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 362 | (resolve_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 363 | (resolve_tac prems 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 364 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 365 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 366 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 367 | (* structural induction for admissible predicates *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 368 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 369 | |
| 297 | 370 | val stream_finite_ind = prove_goal Stream.thy | 
| 371 | "[|P(UU);\ | |
| 372 | \ !! x s1.[|x~=UU;P(s1)|] ==> P(scons[x][s1])\ | |
| 373 | \ |] ==> !s.P(stream_take(n)[s])" | |
| 374 | (fn prems => | |
| 375 | [ | |
| 376 | (nat_ind_tac "n" 1), | |
| 377 | (simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 378 | (resolve_tac prems 1), | |
| 379 | (rtac allI 1), | |
| 380 | 	(res_inst_tac [("s","s")] streamE 1),
 | |
| 381 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 382 | (resolve_tac prems 1), | |
| 383 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 384 | (resolve_tac prems 1), | |
| 385 | (atac 1), | |
| 386 | (etac spec 1) | |
| 387 | ]); | |
| 388 | ||
| 389 | val stream_finite_ind2 = prove_goalw Stream.thy [stream_finite_def] | |
| 390 | "(!!n.P(stream_take(n)[s])) ==> stream_finite(s) -->P(s)" | |
| 391 | (fn prems => | |
| 392 | [ | |
| 393 | (strip_tac 1), | |
| 394 | (etac exE 1), | |
| 395 | (etac subst 1), | |
| 396 | (resolve_tac prems 1) | |
| 397 | ]); | |
| 398 | ||
| 399 | val stream_finite_ind3 = prove_goal Stream.thy | |
| 400 | "[|P(UU);\ | |
| 401 | \ !! x s1.[|x~=UU;P(s1)|] ==> P(scons[x][s1])\ | |
| 402 | \ |] ==> stream_finite(s) --> P(s)" | |
| 403 | (fn prems => | |
| 404 | [ | |
| 405 | (rtac stream_finite_ind2 1), | |
| 406 | (rtac (stream_finite_ind RS spec) 1), | |
| 407 | (REPEAT (resolve_tac prems 1)), | |
| 408 | (REPEAT (atac 1)) | |
| 409 | ]); | |
| 410 | ||
| 243 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 411 | val stream_ind = prove_goal Stream.thy | 
| 297 | 412 | "[|adm(P);\ | 
| 243 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 413 | \ P(UU);\ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 414 | \ !! x s1.[|x~=UU;P(s1)|] ==> P(scons[x][s1])\ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 415 | \ |] ==> P(s)" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 416 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 417 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 418 | (rtac (stream_reach RS subst) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 419 | 	(res_inst_tac [("x","s")] spec 1),
 | 
| 297 | 420 | (rtac wfix_ind 1), | 
| 421 | (rtac adm_impl_admw 1), | |
| 422 | (REPEAT (resolve_tac adm_thms 1)), | |
| 243 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 423 | (rtac adm_subst 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 424 | (contX_tacR 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 425 | (resolve_tac prems 1), | 
| 297 | 426 | (rtac allI 1), | 
| 427 | (rtac (rewrite_rule [stream_take_def] stream_finite_ind) 1), | |
| 428 | (REPEAT (resolve_tac prems 1)), | |
| 429 | (REPEAT (atac 1)) | |
| 243 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 430 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 431 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 432 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 433 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 434 | (* simplify use of Co-induction *) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 435 | (* ------------------------------------------------------------------------*) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 436 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 437 | val surjectiv_scons = prove_goal Stream.thy "scons[shd[s]][stl[s]]=s" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 438 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 439 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 440 | 	(res_inst_tac [("s","s")] streamE 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 441 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 442 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 443 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 444 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 445 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 446 | val stream_coind_lemma2 = prove_goalw Stream.thy [stream_bisim_def] | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 447 | "!s1 s2. R(s1, s2)-->shd[s1]=shd[s2] & R(stl[s1],stl[s2]) ==>stream_bisim(R)" | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 448 | (fn prems => | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 449 | [ | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 450 | (cut_facts_tac prems 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 451 | (strip_tac 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 452 | (etac allE 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 453 | (etac allE 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 454 | (dtac mp 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 455 | (atac 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 456 | (etac conjE 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 457 | 	(res_inst_tac [("Q","s1 = UU & s2 = UU")] classical2 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 458 | (rtac disjI1 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 459 | (fast_tac HOL_cs 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 460 | (rtac disjI2 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 461 | (rtac disjE 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 462 | (etac (de_morgan2 RS ssubst) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 463 | 	(res_inst_tac [("x","shd[s1]")] exI 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 464 | 	(res_inst_tac [("x","stl[s1]")] exI 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 465 | 	(res_inst_tac [("x","stl[s2]")] exI 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 466 | (rtac conjI 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 467 | (eresolve_tac stream_discsel_def 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 468 | (asm_simp_tac (HOLCF_ss addsimps stream_rews addsimps [surjectiv_scons]) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 469 | 	(eres_inst_tac [("s","shd[s1]"),("t","shd[s2]")] subst 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 470 | (simp_tac (HOLCF_ss addsimps stream_rews addsimps [surjectiv_scons]) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 471 | 	(res_inst_tac [("x","shd[s2]")] exI 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 472 | 	(res_inst_tac [("x","stl[s1]")] exI 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 473 | 	(res_inst_tac [("x","stl[s2]")] exI 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 474 | (rtac conjI 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 475 | (eresolve_tac stream_discsel_def 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 476 | (asm_simp_tac (HOLCF_ss addsimps stream_rews addsimps [surjectiv_scons]) 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 477 | 	(res_inst_tac [("s","shd[s1]"),("t","shd[s2]")] ssubst 1),
 | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 478 | (etac sym 1), | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 479 | (simp_tac (HOLCF_ss addsimps stream_rews addsimps [surjectiv_scons]) 1) | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 480 | ]); | 
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 481 | |
| 
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
 nipkow parents: diff
changeset | 482 | |
| 297 | 483 | (* ------------------------------------------------------------------------*) | 
| 484 | (* theorems about finite and infinite streams *) | |
| 485 | (* ------------------------------------------------------------------------*) | |
| 486 | ||
| 487 | (* ----------------------------------------------------------------------- *) | |
| 488 | (* 2 lemmas about stream_finite *) | |
| 489 | (* ----------------------------------------------------------------------- *) | |
| 490 | ||
| 491 | val stream_finite_UU = prove_goalw Stream.thy [stream_finite_def] | |
| 492 | "stream_finite(UU)" | |
| 493 | (fn prems => | |
| 494 | [ | |
| 495 | (rtac exI 1), | |
| 496 | (simp_tac (HOLCF_ss addsimps stream_rews) 1) | |
| 497 | ]); | |
| 498 | ||
| 499 | val inf_stream_not_UU = prove_goal Stream.thy "~stream_finite(s) ==> s ~= UU" | |
| 500 | (fn prems => | |
| 501 | [ | |
| 502 | (cut_facts_tac prems 1), | |
| 503 | (etac swap 1), | |
| 504 | (dtac notnotD 1), | |
| 505 | (hyp_subst_tac 1), | |
| 506 | (rtac stream_finite_UU 1) | |
| 507 | ]); | |
| 508 | ||
| 509 | (* ----------------------------------------------------------------------- *) | |
| 510 | (* a lemma about shd *) | |
| 511 | (* ----------------------------------------------------------------------- *) | |
| 512 | ||
| 513 | val stream_shd_lemma1 = prove_goal Stream.thy "shd[s]=UU --> s=UU" | |
| 514 | (fn prems => | |
| 515 | [ | |
| 516 | 	(res_inst_tac [("s","s")] streamE 1),
 | |
| 517 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 518 | (hyp_subst_tac 1), | |
| 519 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1) | |
| 520 | ]); | |
| 521 | ||
| 522 | ||
| 523 | (* ----------------------------------------------------------------------- *) | |
| 524 | (* lemmas about stream_take *) | |
| 525 | (* ----------------------------------------------------------------------- *) | |
| 526 | ||
| 527 | val stream_take_lemma1 = prove_goal Stream.thy | |
| 528 | "!x xs.x~=UU --> \ | |
| 529 | \ stream_take(Suc(n))[scons[x][xs]] = scons[x][xs] --> stream_take(n)[xs]=xs" | |
| 530 | (fn prems => | |
| 531 | [ | |
| 532 | (rtac allI 1), | |
| 533 | (rtac allI 1), | |
| 534 | (rtac impI 1), | |
| 535 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 536 | (strip_tac 1), | |
| 537 | (rtac ((hd stream_inject) RS conjunct2) 1), | |
| 538 | (atac 1), | |
| 539 | (atac 1), | |
| 540 | (atac 1) | |
| 541 | ]); | |
| 542 | ||
| 543 | ||
| 544 | val stream_take_lemma2 = prove_goal Stream.thy | |
| 545 | "! s2. stream_take(n)[s2] = s2 --> stream_take(Suc(n))[s2]=s2" | |
| 546 | (fn prems => | |
| 547 | [ | |
| 548 | (nat_ind_tac "n" 1), | |
| 549 | (simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 550 | (strip_tac 1 ), | |
| 551 | (hyp_subst_tac 1), | |
| 552 | (simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 553 | (rtac allI 1), | |
| 554 | 	(res_inst_tac [("s","s2")] streamE 1),
 | |
| 555 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 556 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 557 | (strip_tac 1 ), | |
| 558 | (subgoal_tac "stream_take(n1)[xs] = xs" 1), | |
| 559 | (rtac ((hd stream_inject) RS conjunct2) 2), | |
| 560 | (atac 4), | |
| 561 | (atac 2), | |
| 562 | (atac 2), | |
| 563 | (rtac cfun_arg_cong 1), | |
| 564 | (fast_tac HOL_cs 1) | |
| 565 | ]); | |
| 566 | ||
| 567 | val stream_take_lemma3 = prove_goal Stream.thy | |
| 568 | "!x xs.x~=UU --> \ | |
| 569 | \ stream_take(n)[scons[x][xs]] = scons[x][xs] --> stream_take(n)[xs]=xs" | |
| 570 | (fn prems => | |
| 571 | [ | |
| 572 | (nat_ind_tac "n" 1), | |
| 573 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 574 | (strip_tac 1 ), | |
| 575 | 	(res_inst_tac [("P","scons[x][xs]=UU")] notE 1),
 | |
| 576 | (eresolve_tac stream_constrdef 1), | |
| 577 | (etac sym 1), | |
| 578 | (strip_tac 1 ), | |
| 579 | (rtac (stream_take_lemma2 RS spec RS mp) 1), | |
| 580 | 	(res_inst_tac [("x1.1","x")] ((hd stream_inject) RS conjunct2) 1),
 | |
| 581 | (atac 1), | |
| 582 | (atac 1), | |
| 583 | (etac (stream_take2 RS subst) 1) | |
| 584 | ]); | |
| 585 | ||
| 586 | val stream_take_lemma4 = prove_goal Stream.thy | |
| 587 | "!x xs.\ | |
| 588 | \stream_take(n)[xs]=xs --> stream_take(Suc(n))[scons[x][xs]] = scons[x][xs]" | |
| 589 | (fn prems => | |
| 590 | [ | |
| 591 | (nat_ind_tac "n" 1), | |
| 592 | (simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 593 | (simp_tac (HOLCF_ss addsimps stream_rews) 1) | |
| 594 | ]); | |
| 595 | ||
| 596 | (* ---- *) | |
| 597 | ||
| 598 | val stream_take_lemma5 = prove_goal Stream.thy | |
| 599 | "!s. stream_take(n)[s]=s --> iterate(n,stl,s)=UU" | |
| 600 | (fn prems => | |
| 601 | [ | |
| 602 | (nat_ind_tac "n" 1), | |
| 603 | (simp_tac iterate_ss 1), | |
| 604 | (simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 605 | (strip_tac 1), | |
| 606 | 	(res_inst_tac [("s","s")] streamE 1),
 | |
| 607 | (hyp_subst_tac 1), | |
| 608 | (rtac (iterate_Suc2 RS ssubst) 1), | |
| 609 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 610 | (rtac (iterate_Suc2 RS ssubst) 1), | |
| 611 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 612 | (etac allE 1), | |
| 613 | (etac mp 1), | |
| 614 | (hyp_subst_tac 1), | |
| 615 | (etac (stream_take_lemma1 RS spec RS spec RS mp RS mp) 1), | |
| 616 | (atac 1) | |
| 617 | ]); | |
| 618 | ||
| 619 | val stream_take_lemma6 = prove_goal Stream.thy | |
| 620 | "!s.iterate(n,stl,s)=UU --> stream_take(n)[s]=s" | |
| 621 | (fn prems => | |
| 622 | [ | |
| 623 | (nat_ind_tac "n" 1), | |
| 624 | (simp_tac iterate_ss 1), | |
| 625 | (strip_tac 1), | |
| 626 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 627 | (rtac allI 1), | |
| 628 | 	(res_inst_tac [("s","s")] streamE 1),
 | |
| 629 | (hyp_subst_tac 1), | |
| 630 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 631 | (hyp_subst_tac 1), | |
| 632 | (rtac (iterate_Suc2 RS ssubst) 1), | |
| 633 | (asm_simp_tac (HOLCF_ss addsimps stream_rews) 1) | |
| 634 | ]); | |
| 635 | ||
| 636 | val stream_take_lemma7 = prove_goal Stream.thy | |
| 637 | "(iterate(n,stl,s)=UU) = (stream_take(n)[s]=s)" | |
| 638 | (fn prems => | |
| 639 | [ | |
| 640 | (rtac iffI 1), | |
| 641 | (etac (stream_take_lemma6 RS spec RS mp) 1), | |
| 642 | (etac (stream_take_lemma5 RS spec RS mp) 1) | |
| 643 | ]); | |
| 644 | ||
| 645 | ||
| 646 | (* ----------------------------------------------------------------------- *) | |
| 647 | (* lemmas stream_finite *) | |
| 648 | (* ----------------------------------------------------------------------- *) | |
| 649 | ||
| 650 | val stream_finite_lemma1 = prove_goalw Stream.thy [stream_finite_def] | |
| 651 | "stream_finite(xs) ==> stream_finite(scons[x][xs])" | |
| 652 | (fn prems => | |
| 653 | [ | |
| 654 | (cut_facts_tac prems 1), | |
| 655 | (etac exE 1), | |
| 656 | (rtac exI 1), | |
| 657 | (etac (stream_take_lemma4 RS spec RS spec RS mp) 1) | |
| 658 | ]); | |
| 659 | ||
| 660 | val stream_finite_lemma2 = prove_goalw Stream.thy [stream_finite_def] | |
| 661 | "[|x~=UU; stream_finite(scons[x][xs])|] ==> stream_finite(xs)" | |
| 662 | (fn prems => | |
| 663 | [ | |
| 664 | (cut_facts_tac prems 1), | |
| 665 | (etac exE 1), | |
| 666 | (rtac exI 1), | |
| 667 | (etac (stream_take_lemma3 RS spec RS spec RS mp RS mp) 1), | |
| 668 | (atac 1) | |
| 669 | ]); | |
| 670 | ||
| 671 | val stream_finite_lemma3 = prove_goal Stream.thy | |
| 672 | "x~=UU ==> stream_finite(scons[x][xs]) = stream_finite(xs)" | |
| 673 | (fn prems => | |
| 674 | [ | |
| 675 | (cut_facts_tac prems 1), | |
| 676 | (rtac iffI 1), | |
| 677 | (etac stream_finite_lemma2 1), | |
| 678 | (atac 1), | |
| 679 | (etac stream_finite_lemma1 1) | |
| 680 | ]); | |
| 681 | ||
| 682 | ||
| 683 | val stream_finite_lemma5 = prove_goalw Stream.thy [stream_finite_def] | |
| 684 | "(!n. s1 << s2 --> stream_take(n)[s2] = s2 --> stream_finite(s1))\ | |
| 685 | \=(s1 << s2 --> stream_finite(s2) --> stream_finite(s1))" | |
| 686 | (fn prems => | |
| 687 | [ | |
| 688 | (rtac iffI 1), | |
| 689 | (fast_tac HOL_cs 1), | |
| 690 | (fast_tac HOL_cs 1) | |
| 691 | ]); | |
| 692 | ||
| 693 | val stream_finite_lemma6 = prove_goal Stream.thy | |
| 694 | "!s1 s2. s1 << s2 --> stream_take(n)[s2] = s2 --> stream_finite(s1)" | |
| 695 | (fn prems => | |
| 696 | [ | |
| 697 | (nat_ind_tac "n" 1), | |
| 698 | (simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 699 | (strip_tac 1 ), | |
| 700 | (hyp_subst_tac 1), | |
| 701 | (dtac UU_I 1), | |
| 702 | (hyp_subst_tac 1), | |
| 703 | (rtac stream_finite_UU 1), | |
| 704 | (rtac allI 1), | |
| 705 | (rtac allI 1), | |
| 706 | 	(res_inst_tac [("s","s1")] streamE 1),
 | |
| 707 | (hyp_subst_tac 1), | |
| 708 | (strip_tac 1 ), | |
| 709 | (rtac stream_finite_UU 1), | |
| 710 | (hyp_subst_tac 1), | |
| 711 | 	(res_inst_tac [("s","s2")] streamE 1),
 | |
| 712 | (hyp_subst_tac 1), | |
| 713 | (strip_tac 1 ), | |
| 714 | (dtac UU_I 1), | |
| 715 | (asm_simp_tac(HOLCF_ss addsimps (stream_rews @ [stream_finite_UU])) 1), | |
| 716 | (hyp_subst_tac 1), | |
| 717 | (simp_tac (HOLCF_ss addsimps stream_rews) 1), | |
| 718 | (strip_tac 1 ), | |
| 719 | (rtac stream_finite_lemma1 1), | |
| 720 | (subgoal_tac "xs << xsa" 1), | |
| 721 | (subgoal_tac "stream_take(n1)[xsa] = xsa" 1), | |
| 722 | (fast_tac HOL_cs 1), | |
| 723 | 	(res_inst_tac  [("x1.1","xa"),("y1.1","xa")] 
 | |
| 724 | ((hd stream_inject) RS conjunct2) 1), | |
| 725 | (atac 1), | |
| 726 | (atac 1), | |
| 727 | (atac 1), | |
| 728 | 	(res_inst_tac [("x1.1","x"),("y1.1","xa")]
 | |
| 729 | ((hd stream_invert) RS conjunct2) 1), | |
| 730 | (atac 1), | |
| 731 | (atac 1), | |
| 732 | (atac 1) | |
| 733 | ]); | |
| 734 | ||
| 735 | val stream_finite_lemma7 = prove_goal Stream.thy | |
| 736 | "s1 << s2 --> stream_finite(s2) --> stream_finite(s1)" | |
| 737 | (fn prems => | |
| 738 | [ | |
| 739 | (rtac (stream_finite_lemma5 RS iffD1) 1), | |
| 740 | (rtac allI 1), | |
| 741 | (rtac (stream_finite_lemma6 RS spec RS spec) 1) | |
| 742 | ]); | |
| 743 | ||
| 744 | val stream_finite_lemma8 = prove_goalw Stream.thy [stream_finite_def] | |
| 745 | "stream_finite(s) = (? n. iterate(n,stl,s)=UU)" | |
| 746 | (fn prems => | |
| 747 | [ | |
| 748 | (simp_tac (HOL_ss addsimps [stream_take_lemma7]) 1) | |
| 749 | ]); | |
| 750 | ||
| 751 | ||
| 752 | (* ----------------------------------------------------------------------- *) | |
| 753 | (* admissibility of ~stream_finite *) | |
| 754 | (* ----------------------------------------------------------------------- *) | |
| 755 | ||
| 756 | val adm_not_stream_finite = prove_goalw Stream.thy [adm_def] | |
| 757 | "adm(%s. ~ stream_finite(s))" | |
| 758 | (fn prems => | |
| 759 | [ | |
| 760 | (strip_tac 1 ), | |
| 761 | 	(res_inst_tac [("P1","!i. ~ stream_finite(Y(i))")] classical3 1),
 | |
| 762 | (atac 2), | |
| 763 | (subgoal_tac "!i.stream_finite(Y(i))" 1), | |
| 764 | (fast_tac HOL_cs 1), | |
| 765 | (rtac allI 1), | |
| 766 | (rtac (stream_finite_lemma7 RS mp RS mp) 1), | |
| 767 | (etac is_ub_thelub 1), | |
| 768 | (atac 1) | |
| 769 | ]); | |
| 770 | ||
| 771 | (* ----------------------------------------------------------------------- *) | |
| 772 | (* alternative prove for admissibility of ~stream_finite *) | |
| 773 | (* show that stream_finite(s) = (? n. iterate(n, stl, s) = UU) *) | |
| 774 | (* and prove adm. of ~(? n. iterate(n, stl, s) = UU) *) | |
| 775 | (* proof uses theorems stream_take_lemma5-7; stream_finite_lemma8 *) | |
| 776 | (* ----------------------------------------------------------------------- *) | |
| 777 | ||
| 778 | ||
| 779 | val adm_not_stream_finite2=prove_goal Stream.thy "adm(%s. ~ stream_finite(s))" | |
| 780 | (fn prems => | |
| 781 | [ | |
| 782 | (subgoal_tac "(!s.(~stream_finite(s))=(!n.iterate(n,stl,s)~=UU))" 1), | |
| 783 | (etac (adm_cong RS iffD2)1), | |
| 784 | (REPEAT(resolve_tac adm_thms 1)), | |
| 785 | (rtac contX_iterate2 1), | |
| 786 | (rtac allI 1), | |
| 787 | (rtac (stream_finite_lemma8 RS ssubst) 1), | |
| 788 | (fast_tac HOL_cs 1) | |
| 789 | ]); | |
| 790 | ||
| 791 |