author | nipkow |
Sat, 16 Nov 2013 18:26:57 +0100 | |
changeset 54459 | f43ae1afd08a |
parent 52435 | 6646bb548c6b |
child 55416 | dd7992d4a61a |
permissions | -rw-r--r-- |
50138 | 1 |
header "Immutable Arrays with Code Generation" |
2 |
||
3 |
theory IArray |
|
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
4 |
imports Main |
50138 | 5 |
begin |
6 |
||
7 |
text{* Immutable arrays are lists wrapped up in an additional constructor. |
|
8 |
There are no update operations. Hence code generation can safely implement |
|
9 |
this type by efficient target language arrays. Currently only SML is |
|
10 |
provided. Should be extended to other target languages and more operations. |
|
11 |
||
12 |
Note that arrays cannot be printed directly but only by turning them into |
|
13 |
lists first. Arrays could be converted back into lists for printing if they |
|
14 |
were wrapped up in an additional constructor. *} |
|
15 |
||
16 |
datatype 'a iarray = IArray "'a list" |
|
17 |
||
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
18 |
primrec list_of :: "'a iarray \<Rightarrow> 'a list" where |
50138 | 19 |
"list_of (IArray xs) = xs" |
20 |
hide_const (open) list_of |
|
21 |
||
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
22 |
definition of_fun :: "(nat \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a iarray" where |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
23 |
[simp]: "of_fun f n = IArray (map f [0..<n])" |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
24 |
hide_const (open) of_fun |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
25 |
|
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
26 |
definition sub :: "'a iarray \<Rightarrow> nat \<Rightarrow> 'a" (infixl "!!" 100) where |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
27 |
[simp]: "as !! n = IArray.list_of as ! n" |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
28 |
hide_const (open) sub |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
29 |
|
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
30 |
definition length :: "'a iarray \<Rightarrow> nat" where |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
31 |
[simp]: "length as = List.length (IArray.list_of as)" |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
32 |
hide_const (open) length |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
33 |
|
54459 | 34 |
fun all :: "('a \<Rightarrow> bool) \<Rightarrow> 'a iarray \<Rightarrow> bool" where |
35 |
"all p (IArray as) = (ALL a : set as. p a)" |
|
36 |
hide_const (open) all |
|
37 |
||
38 |
fun exists :: "('a \<Rightarrow> bool) \<Rightarrow> 'a iarray \<Rightarrow> bool" where |
|
39 |
"exists p (IArray as) = (EX a : set as. p a)" |
|
40 |
hide_const (open) exists |
|
41 |
||
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
42 |
lemma list_of_code [code]: |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
43 |
"IArray.list_of as = map (\<lambda>n. as !! n) [0 ..< IArray.length as]" |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
44 |
by (cases as) (simp add: map_nth) |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
45 |
|
50138 | 46 |
|
47 |
subsection "Code Generation" |
|
48 |
||
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
49 |
code_reserved SML Vector |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
50 |
|
52435
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
51161
diff
changeset
|
51 |
code_printing |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
51161
diff
changeset
|
52 |
type_constructor iarray \<rightharpoonup> (SML) "_ Vector.vector" |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
51161
diff
changeset
|
53 |
| constant IArray \<rightharpoonup> (SML) "Vector.fromList" |
54459 | 54 |
| constant IArray.all \<rightharpoonup> (SML) "Vector.all" |
55 |
| constant IArray.exists \<rightharpoonup> (SML) "Vector.exists" |
|
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
56 |
|
51161
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
57 |
lemma [code]: |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
58 |
"size (as :: 'a iarray) = 0" |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
59 |
by (cases as) simp |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
60 |
|
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
61 |
lemma [code]: |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
62 |
"iarray_size f as = Suc (list_size f (IArray.list_of as))" |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
63 |
by (cases as) simp |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
64 |
|
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
65 |
lemma [code]: |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
66 |
"iarray_rec f as = f (IArray.list_of as)" |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
67 |
by (cases as) simp |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
68 |
|
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
69 |
lemma [code]: |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
70 |
"iarray_case f as = f (IArray.list_of as)" |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
71 |
by (cases as) simp |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
72 |
|
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
73 |
lemma [code]: |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
74 |
"HOL.equal as bs \<longleftrightarrow> HOL.equal (IArray.list_of as) (IArray.list_of bs)" |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
75 |
by (cases as, cases bs) (simp add: equal) |
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
haftmann
parents:
51143
diff
changeset
|
76 |
|
51143
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
haftmann
parents:
51094
diff
changeset
|
77 |
primrec tabulate :: "integer \<times> (integer \<Rightarrow> 'a) \<Rightarrow> 'a iarray" where |
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
haftmann
parents:
51094
diff
changeset
|
78 |
"tabulate (n, f) = IArray (map (f \<circ> integer_of_nat) [0..<nat_of_integer n])" |
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
79 |
hide_const (open) tabulate |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
80 |
|
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
81 |
lemma [code]: |
51143
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
haftmann
parents:
51094
diff
changeset
|
82 |
"IArray.of_fun f n = IArray.tabulate (integer_of_nat n, f \<circ> nat_of_integer)" |
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
83 |
by simp |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
84 |
|
52435
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
51161
diff
changeset
|
85 |
code_printing |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
51161
diff
changeset
|
86 |
constant IArray.tabulate \<rightharpoonup> (SML) "Vector.tabulate" |
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
87 |
|
51143
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
haftmann
parents:
51094
diff
changeset
|
88 |
primrec sub' :: "'a iarray \<times> integer \<Rightarrow> 'a" where |
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
haftmann
parents:
51094
diff
changeset
|
89 |
"sub' (as, n) = IArray.list_of as ! nat_of_integer n" |
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
90 |
hide_const (open) sub' |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
91 |
|
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
92 |
lemma [code]: |
51143
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
haftmann
parents:
51094
diff
changeset
|
93 |
"as !! n = IArray.sub' (as, integer_of_nat n)" |
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
94 |
by simp |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
95 |
|
52435
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
51161
diff
changeset
|
96 |
code_printing |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
51161
diff
changeset
|
97 |
constant IArray.sub' \<rightharpoonup> (SML) "Vector.sub" |
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
98 |
|
51143
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
haftmann
parents:
51094
diff
changeset
|
99 |
definition length' :: "'a iarray \<Rightarrow> integer" where |
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
haftmann
parents:
51094
diff
changeset
|
100 |
[simp]: "length' as = integer_of_nat (List.length (IArray.list_of as))" |
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
101 |
hide_const (open) length' |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
102 |
|
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
103 |
lemma [code]: |
51143
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
haftmann
parents:
51094
diff
changeset
|
104 |
"IArray.length as = nat_of_integer (IArray.length' as)" |
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
105 |
by simp |
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
106 |
|
52435
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
51161
diff
changeset
|
107 |
code_printing |
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
haftmann
parents:
51161
diff
changeset
|
108 |
constant IArray.length' \<rightharpoonup> (SML) "Vector.length" |
50138 | 109 |
|
110 |
end |
|
51094
84b03c49c223
IArray ignorant of particular representation of nat
haftmann
parents:
50138
diff
changeset
|
111 |