| author | wenzelm | 
| Sun, 05 Jul 2015 23:01:33 +0200 | |
| changeset 60651 | 1049f3724ac0 | 
| parent 60500 | 903bb1495239 | 
| child 61115 | 3a4400985780 | 
| permissions | -rw-r--r-- | 
| 58881 | 1 | section "Immutable Arrays with Code Generation" | 
| 50138 | 2 | |
| 3 | theory IArray | |
| 51094 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 4 | imports Main | 
| 50138 | 5 | begin | 
| 6 | ||
| 60500 | 7 | text\<open>Immutable arrays are lists wrapped up in an additional constructor. | 
| 50138 | 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 | |
| 60500 | 14 | were wrapped up in an additional constructor.\<close> | 
| 50138 | 15 | |
| 58310 | 16 | datatype 'a iarray = IArray "'a list" | 
| 50138 | 17 | |
| 51094 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
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: 
50138diff
changeset | 22 | definition of_fun :: "(nat \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a iarray" where | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 23 | [simp]: "of_fun f n = IArray (map f [0..<n])" | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 24 | hide_const (open) of_fun | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 25 | |
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 26 | definition sub :: "'a iarray \<Rightarrow> nat \<Rightarrow> 'a" (infixl "!!" 100) where | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 27 | [simp]: "as !! n = IArray.list_of as ! n" | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 28 | hide_const (open) sub | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 29 | |
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 30 | definition length :: "'a iarray \<Rightarrow> nat" where | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 31 | [simp]: "length as = List.length (IArray.list_of as)" | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 32 | hide_const (open) length | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
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: 
50138diff
changeset | 42 | lemma list_of_code [code]: | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
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: 
50138diff
changeset | 44 | by (cases as) (simp add: map_nth) | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 45 | |
| 50138 | 46 | |
| 47 | subsection "Code Generation" | |
| 48 | ||
| 51094 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 49 | code_reserved SML Vector | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 50 | |
| 52435 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
51161diff
changeset | 51 | code_printing | 
| 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
51161diff
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: 
51161diff
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: 
50138diff
changeset | 56 | |
| 51161 
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
 haftmann parents: 
51143diff
changeset | 57 | lemma [code]: | 
| 58269 | 58 | "size (as :: 'a iarray) = Suc (length (IArray.list_of as))" | 
| 59 | by (cases as) simp | |
| 51161 
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
 haftmann parents: 
51143diff
changeset | 60 | |
| 
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
 haftmann parents: 
51143diff
changeset | 61 | lemma [code]: | 
| 58269 | 62 | "size_iarray f as = Suc (size_list f (IArray.list_of as))" | 
| 63 | by (cases as) simp | |
| 64 | ||
| 65 | lemma [code]: | |
| 66 | "rec_iarray f as = f (IArray.list_of as)" | |
| 67 | by (cases as) simp | |
| 68 | ||
| 69 | lemma [code]: | |
| 70 | "case_iarray f as = f (IArray.list_of as)" | |
| 71 | by (cases as) simp | |
| 51161 
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
 haftmann parents: 
51143diff
changeset | 72 | |
| 
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
 haftmann parents: 
51143diff
changeset | 73 | lemma [code]: | 
| 58269 | 74 | "set_iarray as = set (IArray.list_of as)" | 
| 75 | by (case_tac as) auto | |
| 76 | ||
| 77 | lemma [code]: | |
| 78 | "map_iarray f as = IArray (map f (IArray.list_of as))" | |
| 79 | by (case_tac as) auto | |
| 51161 
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
 haftmann parents: 
51143diff
changeset | 80 | |
| 
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
 haftmann parents: 
51143diff
changeset | 81 | lemma [code]: | 
| 58269 | 82 | "rel_iarray r as bs = list_all2 r (IArray.list_of as) (IArray.list_of bs)" | 
| 83 | by (case_tac as) (case_tac bs, auto) | |
| 51161 
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
 haftmann parents: 
51143diff
changeset | 84 | |
| 
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
 haftmann parents: 
51143diff
changeset | 85 | lemma [code]: | 
| 58269 | 86 | "HOL.equal as bs \<longleftrightarrow> HOL.equal (IArray.list_of as) (IArray.list_of bs)" | 
| 87 | by (cases as, cases bs) (simp add: equal) | |
| 51161 
6ed12ae3b3e1
attempt to re-establish conventions which theories are loaded into the grand unified library theory;
 haftmann parents: 
51143diff
changeset | 88 | |
| 51143 
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
 haftmann parents: 
51094diff
changeset | 89 | primrec tabulate :: "integer \<times> (integer \<Rightarrow> 'a) \<Rightarrow> 'a iarray" where | 
| 58269 | 90 | "tabulate (n, f) = IArray (map (f \<circ> integer_of_nat) [0..<nat_of_integer n])" | 
| 91 | ||
| 51094 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 92 | hide_const (open) tabulate | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 93 | |
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 94 | lemma [code]: | 
| 58269 | 95 | "IArray.of_fun f n = IArray.tabulate (integer_of_nat n, f \<circ> nat_of_integer)" | 
| 96 | by simp | |
| 51094 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 97 | |
| 52435 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
51161diff
changeset | 98 | code_printing | 
| 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
51161diff
changeset | 99 | constant IArray.tabulate \<rightharpoonup> (SML) "Vector.tabulate" | 
| 51094 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 100 | |
| 51143 
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
 haftmann parents: 
51094diff
changeset | 101 | primrec sub' :: "'a iarray \<times> integer \<Rightarrow> 'a" where | 
| 58269 | 102 | [code del]: "sub' (as, n) = IArray.list_of as ! nat_of_integer n" | 
| 103 | ||
| 51094 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 104 | hide_const (open) sub' | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 105 | |
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 106 | lemma [code]: | 
| 57117 | 107 | "IArray.sub' (IArray as, n) = as ! nat_of_integer n" | 
| 108 | by simp | |
| 109 | ||
| 110 | lemma [code]: | |
| 58269 | 111 | "as !! n = IArray.sub' (as, integer_of_nat n)" | 
| 112 | by simp | |
| 51094 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 113 | |
| 52435 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
51161diff
changeset | 114 | code_printing | 
| 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
51161diff
changeset | 115 | constant IArray.sub' \<rightharpoonup> (SML) "Vector.sub" | 
| 51094 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 116 | |
| 51143 
0a2371e7ced3
two target language numeral types: integer and natural, as replacement for code_numeral;
 haftmann parents: 
51094diff
changeset | 117 | definition length' :: "'a iarray \<Rightarrow> integer" where | 
| 58269 | 118 | [code del, simp]: "length' as = integer_of_nat (List.length (IArray.list_of as))" | 
| 119 | ||
| 51094 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 120 | hide_const (open) length' | 
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 121 | |
| 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 122 | lemma [code]: | 
| 57117 | 123 | "IArray.length' (IArray as) = integer_of_nat (List.length as)" | 
| 124 | by simp | |
| 125 | ||
| 126 | lemma [code]: | |
| 58269 | 127 | "IArray.length as = nat_of_integer (IArray.length' as)" | 
| 128 | by simp | |
| 51094 
84b03c49c223
IArray ignorant of particular representation of nat
 haftmann parents: 
50138diff
changeset | 129 | |
| 59457 | 130 | context term_syntax | 
| 131 | begin | |
| 132 | ||
| 133 | lemma [code]: | |
| 134 | "Code_Evaluation.term_of (as :: 'a::typerep iarray) = | |
| 135 |     Code_Evaluation.Const (STR ''IArray.iarray.IArray'') (TYPEREP('a list \<Rightarrow> 'a iarray)) <\<cdot>> (Code_Evaluation.term_of (IArray.list_of as))"
 | |
| 136 | by (subst term_of_anything) rule | |
| 137 | ||
| 138 | end | |
| 139 | ||
| 52435 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
51161diff
changeset | 140 | code_printing | 
| 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
51161diff
changeset | 141 | constant IArray.length' \<rightharpoonup> (SML) "Vector.length" | 
| 50138 | 142 | |
| 143 | end |