author | huffman |
Fri, 27 Feb 2009 19:05:46 -0800 | |
changeset 30158 | 83c50c62cf23 |
parent 16554 | 5841e7f9eef5 |
child 31008 | b8f4e351b5bf |
permissions | -rw-r--r-- |
16554 | 1 |
(* Title: HOLCF/ex/Fixrec_ex.thy |
2 |
Author: Brian Huffman |
|
3 |
*) |
|
4 |
||
5 |
header {* Fixrec package examples *} |
|
6 |
||
7 |
theory Fixrec_ex |
|
8 |
imports HOLCF |
|
9 |
begin |
|
10 |
||
11 |
subsection {* basic fixrec examples *} |
|
12 |
||
13 |
text {* |
|
14 |
Fixrec patterns can mention any constructor defined by the domain |
|
15 |
package, as well as any of the following built-in constructors: |
|
16 |
cpair, spair, sinl, sinr, up, ONE, TT, FF. |
|
17 |
*} |
|
18 |
||
19 |
text {* typical usage is with lazy constructors *} |
|
20 |
||
30158
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
21 |
fixrec down :: "'a u \<rightarrow> 'a" |
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
22 |
where "down\<cdot>(up\<cdot>x) = x" |
16554 | 23 |
|
24 |
text {* with strict constructors, rewrite rules may require side conditions *} |
|
25 |
||
30158
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
26 |
fixrec from_sinl :: "'a \<oplus> 'b \<rightarrow> 'a" |
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
27 |
where "x \<noteq> \<bottom> \<Longrightarrow> from_sinl\<cdot>(sinl\<cdot>x) = x" |
16554 | 28 |
|
29 |
text {* lifting can turn a strict constructor into a lazy one *} |
|
30 |
||
30158
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
31 |
fixrec from_sinl_up :: "'a u \<oplus> 'b \<rightarrow> 'a" |
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
32 |
where "from_sinl_up\<cdot>(sinl\<cdot>(up\<cdot>x)) = x" |
16554 | 33 |
|
34 |
||
35 |
subsection {* fixpat examples *} |
|
36 |
||
37 |
text {* a type of lazy lists *} |
|
38 |
||
39 |
domain 'a llist = lNil | lCons (lazy 'a) (lazy "'a llist") |
|
40 |
||
41 |
text {* zip function for lazy lists *} |
|
42 |
||
43 |
text {* notice that the patterns are not exhaustive *} |
|
44 |
||
45 |
fixrec |
|
30158
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
46 |
lzip :: "'a llist \<rightarrow> 'b llist \<rightarrow> ('a \<times> 'b) llist" |
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
47 |
where |
16554 | 48 |
"lzip\<cdot>(lCons\<cdot>x\<cdot>xs)\<cdot>(lCons\<cdot>y\<cdot>ys) = lCons\<cdot><x,y>\<cdot>(lzip\<cdot>xs\<cdot>ys)" |
30158
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
49 |
| "lzip\<cdot>lNil\<cdot>lNil = lNil" |
16554 | 50 |
|
51 |
text {* fixpat is useful for producing strictness theorems *} |
|
52 |
text {* note that pattern matching is done in left-to-right order *} |
|
53 |
||
54 |
fixpat lzip_stricts [simp]: |
|
55 |
"lzip\<cdot>\<bottom>\<cdot>ys" |
|
56 |
"lzip\<cdot>lNil\<cdot>\<bottom>" |
|
57 |
"lzip\<cdot>(lCons\<cdot>x\<cdot>xs)\<cdot>\<bottom>" |
|
58 |
||
59 |
text {* fixpat can also produce rules for missing cases *} |
|
60 |
||
61 |
fixpat lzip_undefs [simp]: |
|
62 |
"lzip\<cdot>lNil\<cdot>(lCons\<cdot>y\<cdot>ys)" |
|
63 |
"lzip\<cdot>(lCons\<cdot>x\<cdot>xs)\<cdot>lNil" |
|
64 |
||
65 |
||
66 |
subsection {* skipping proofs of rewrite rules *} |
|
67 |
||
68 |
text {* another zip function for lazy lists *} |
|
69 |
||
70 |
text {* |
|
71 |
Notice that this version has overlapping patterns. |
|
72 |
The second equation cannot be proved as a theorem |
|
73 |
because it only applies when the first pattern fails. |
|
74 |
*} |
|
75 |
||
76 |
fixrec (permissive) |
|
30158
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
77 |
lzip2 :: "'a llist \<rightarrow> 'b llist \<rightarrow> ('a \<times> 'b) llist" |
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
78 |
where |
16554 | 79 |
"lzip2\<cdot>(lCons\<cdot>x\<cdot>xs)\<cdot>(lCons\<cdot>y\<cdot>ys) = lCons\<cdot><x,y>\<cdot>(lzip\<cdot>xs\<cdot>ys)" |
30158
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
80 |
| "lzip2\<cdot>xs\<cdot>ys = lNil" |
16554 | 81 |
|
82 |
text {* |
|
83 |
Usually fixrec tries to prove all equations as theorems. |
|
84 |
The "permissive" option overrides this behavior, so fixrec |
|
85 |
does not produce any simp rules. |
|
86 |
*} |
|
87 |
||
88 |
text {* simp rules can be generated later using fixpat *} |
|
89 |
||
90 |
fixpat lzip2_simps [simp]: |
|
91 |
"lzip2\<cdot>(lCons\<cdot>x\<cdot>xs)\<cdot>(lCons\<cdot>y\<cdot>ys)" |
|
92 |
"lzip2\<cdot>(lCons\<cdot>x\<cdot>xs)\<cdot>lNil" |
|
93 |
"lzip2\<cdot>lNil\<cdot>(lCons\<cdot>y\<cdot>ys)" |
|
94 |
"lzip2\<cdot>lNil\<cdot>lNil" |
|
95 |
||
96 |
fixpat lzip2_stricts [simp]: |
|
97 |
"lzip2\<cdot>\<bottom>\<cdot>ys" |
|
98 |
"lzip2\<cdot>(lCons\<cdot>x\<cdot>xs)\<cdot>\<bottom>" |
|
99 |
||
100 |
subsection {* mutual recursion with fixrec *} |
|
101 |
||
102 |
text {* tree and forest types *} |
|
103 |
||
104 |
domain 'a tree = Leaf (lazy 'a) | Branch (lazy "'a forest") |
|
105 |
and 'a forest = Empty | Trees (lazy "'a tree") "'a forest" |
|
106 |
||
107 |
text {* |
|
108 |
To define mutually recursive functions, separate the equations |
|
109 |
for each function using the keyword "and". |
|
110 |
*} |
|
111 |
||
112 |
fixrec |
|
30158
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
113 |
map_tree :: "('a \<rightarrow> 'b) \<rightarrow> ('a tree \<rightarrow> 'b tree)" |
16554 | 114 |
and |
30158
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
115 |
map_forest :: "('a \<rightarrow> 'b) \<rightarrow> ('a forest \<rightarrow> 'b forest)" |
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
116 |
where |
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
117 |
"map_tree\<cdot>f\<cdot>(Leaf\<cdot>x) = Leaf\<cdot>(f\<cdot>x)" |
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
118 |
| "map_tree\<cdot>f\<cdot>(Branch\<cdot>ts) = Branch\<cdot>(map_forest\<cdot>f\<cdot>ts)" |
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
119 |
| "map_forest\<cdot>f\<cdot>Empty = Empty" |
83c50c62cf23
fixrec package uses new-style syntax and local-theory interface
huffman
parents:
16554
diff
changeset
|
120 |
| "ts \<noteq> \<bottom> \<Longrightarrow> |
16554 | 121 |
map_forest\<cdot>f\<cdot>(Trees\<cdot>t\<cdot>ts) = Trees\<cdot>(map_tree\<cdot>f\<cdot>t)\<cdot>(map_forest\<cdot>f\<cdot>ts)" |
122 |
||
123 |
fixpat map_tree_strict [simp]: "map_tree\<cdot>f\<cdot>\<bottom>" |
|
124 |
fixpat map_forest_strict [simp]: "map_forest\<cdot>f\<cdot>\<bottom>" |
|
125 |
||
126 |
text {* |
|
127 |
Theorems generated: |
|
128 |
map_tree_def map_forest_def |
|
129 |
map_tree_unfold map_forest_unfold |
|
130 |
map_tree_simps map_forest_simps |
|
131 |
map_tree_map_forest_induct |
|
132 |
*} |
|
133 |
||
134 |
end |