| author | wenzelm | 
| Mon, 05 Jul 1999 09:52:25 +0200 | |
| changeset 6898 | 2650bd68c0ba | 
| 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  |