1 (* Title: functions on lists for Programs
2 Author: Walther Neuper 0108
3 (c) due to copyright terms
6 theory ListC imports KEStore
17 subsection \<open>Notes on Isac's programming language\<close>
19 Isac's programming language combines tacticals (TRY, etc) and
20 tactics (Rewrite, etc) with list processing.
22 In order to distinguish list expressions of the meta (programming)
23 language from the object language in Lucas-Interpretation, a
24 new 'type xlist' is introduced.
25 TODO: Switch the role of 'xlist' and 'list' (the former only used
28 Isac's programming language preceeded the function package
29 in 2002. For naming "axiomatization" is used for reasons of uniformity
30 with the other replacements for "axioms".
31 Another reminiscence from Isabelle2002 are Isac-specific numerals,
32 introduced in order to have floating point numerals at a time,
33 when Isabelle did not consider that requirement. For the sake of uniformity
34 'nat' from List.thy is replaced by 'real' by 'fun parse',
35 however, 'fun parseNEW' has started to replace this fix (after finishing
36 this fix, there will be a 'rename all parseNEW --> parse).
38 Note: *one* "axiomatization" over all equations caused strange "'a list list"
42 subsection \<open>General constants\<close>
44 EmptyList :: "bool list"
45 UniversalList :: "bool list"
49 val UniversalList = (Thm.term_of o the o (TermC.parse @{theory})) "UniversalList";
50 val EmptyList = (Thm.term_of o the o (TermC.parse @{theory})) "[]::bool list";
54 subsection \<open>Type 'xlist' for Lucas-Interpretation | for InsSort.thy\<close>
55 (* cp fom ~~/src/HOL/List.thy
56 TODO: ask for shorter deliminters in xlist *)
59 | XCons (xhd: 'a) (xtl: "'a xlist") (infixr "@#" 65)
62 \<comment> \<open>list Enumeration\<close>
63 "_xlist" :: "args => 'a xlist" ("{|| (_) ||}")
66 "{||x, xs||}" == "x@#{||xs||}"
67 "{||x||}" == "x@#{|| ||}"
72 subsection \<open>Functions for 'xlist'\<close>
74 (1) revise, if definition of identifiers like LENGTH_NIL are still required.
75 (2) switch the role of 'xlist' and 'list' in the functions below, in particular for
76 'foldr', 'foldr_Nil', 'foldr_Cons' and 'xfoldr', 'xfoldr_Nil', 'xfoldr_Cons'.
77 For transition phase just outcomment InsSort.thy and inssort.sml.
80 primrec xfoldr :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a xlist \<Rightarrow> 'b \<Rightarrow> 'b" where
81 xfoldr_Nil: "xfoldr f {|| ||} = id" |
82 xfoldr_Cons: "xfoldr f (x @# xs) = f x \<circ> xfoldr f xs"
84 primrec LENGTH :: "'a list => real"
86 LENGTH_NIL: "LENGTH [] = 0" |
87 LENGTH_CONS: "LENGTH (x#xs) = 1 + LENGTH xs"
89 subsection \<open>Functions for 'list'\<close>
91 consts NTH :: "[real, 'a list] => 'a"
93 NTH_NIL: "NTH 1 (x # xs) = x" and
94 NTH_CONS: (*NO primrec, fun ..*)"1 < n ==> NTH n (x # xs) = NTH (n + -1) xs"
96 (* redefine together with identifiers (still) required for KEStore ..*)
98 hd_thm: "hd (x # xs) = x"
101 tl_Nil: "tl [] = []" and
102 tl_Cons: "tl (x # xs) = xs"
105 LAST: "last (x # xs) = (if xs = [] then x else last xs)"
108 butlast_Nil: "butlast [] = []" and
109 butlast_Cons: "butlast (x # xs) = (if xs = [] then [] else x # butlast xs)"
112 map_Nil:"map f [] = []" and
113 map_Cons: "map f (x # xs) = f x # map f xs"
116 rev_Nil: "rev [] = []" and
117 rev_Cons: "rev (x # xs) = rev xs @ [x]"
120 filter_Nil: "filter P [] = []" and
121 filter_Cons: "filter P (x # xs) = (if P x then x # filter P xs else filter P xs)"
124 concat_Nil: "concat [] = []" and
125 concat_Cons: "concat (x # xs) = x @ concat xs"
128 takeWhile_Nil: "takeWhile P [] = []" and
129 takeWhile_Cons: "takeWhile P (x # xs) = (if P x then x # takeWhile P xs else [])"
132 dropWhile_Nil: "dropWhile P [] = []" and
133 dropWhile_Cons: "dropWhile P (x # xs) = (if P x then dropWhile P xs else x#xs)"
136 zip_Nil: "zip xs [] = []" and
137 zip_Cons: "zip xs (y # ys) = (case xs of [] => [] | z # zs => (z,y) # zip zs ys)"
140 distinct_Nil: "distinct [] = True" and
141 distinct_Cons: "distinct (x # xs) = (x ~: set xs & distinct xs)"
144 remdups_Nil: "remdups [] = []" and
145 remdups_Cons: "remdups (x#xs) = (if x : set xs then remdups xs else x # remdups xs)"
147 consts lastI :: "'a list \<Rightarrow> 'a"
149 last_thmI: "lastI (x#xs) = (if xs = [] then x else lastI xs)"
151 subsection \<open>rule set for evaluating Porg_Expr, will be extended in several thys\<close>
154 Rule.Rls {id = "list_rls", preconds = [], rew_ord = ("dummy_ord", Rule.dummy_ord),
155 erls = Rule.Erls, srls = Rule.Erls, calc = [], errpatts = [],
156 rules = [Rule.Thm ("refl", TermC.num_str @{thm refl}), (*'a<>b -> FALSE' by fun eval_equal*)
157 Rule.Thm ("o_apply", TermC.num_str @{thm o_apply}),
159 Rule.Thm ("NTH_CONS",TermC.num_str @{thm NTH_CONS}),(*erls for cond. in Atools.ML*)
160 Rule.Thm ("NTH_NIL",TermC.num_str @{thm NTH_NIL}),
161 Rule.Thm ("append_Cons",TermC.num_str @{thm append_Cons}),
162 Rule.Thm ("append_Nil",TermC.num_str @{thm append_Nil}),
163 (* Thm ("butlast_Cons",num_str @{thm butlast_Cons}),
164 Thm ("butlast_Nil",num_str @{thm butlast_Nil}),*)
165 Rule.Thm ("concat_Cons",TermC.num_str @{thm concat_Cons}),
166 Rule.Thm ("concat_Nil",TermC.num_str @{thm concat_Nil}),
167 (* Rule.Thm ("del_base",num_str @{thm del_base}),
168 Rule.Thm ("del_rec",num_str @{thm del_rec}), *)
170 Rule.Thm ("distinct_Cons",TermC.num_str @{thm distinct_Cons}),
171 Rule.Thm ("distinct_Nil",TermC.num_str @{thm distinct_Nil}),
172 Rule.Thm ("dropWhile_Cons",TermC.num_str @{thm dropWhile_Cons}),
173 Rule.Thm ("dropWhile_Nil",TermC.num_str @{thm dropWhile_Nil}),
174 Rule.Thm ("filter_Cons",TermC.num_str @{thm filter_Cons}),
175 Rule.Thm ("filter_Nil",TermC.num_str @{thm filter_Nil}),
176 Rule.Thm ("foldr_Cons",TermC.num_str @{thm foldr_Cons}),
177 Rule.Thm ("foldr_Nil",TermC.num_str @{thm foldr_Nil}),
178 Rule.Thm ("hd_thm",TermC.num_str @{thm hd_thm}),
179 Rule.Thm ("LAST",TermC.num_str @{thm LAST}),
180 Rule.Thm ("LENGTH_CONS",TermC.num_str @{thm LENGTH_CONS}),
181 Rule.Thm ("LENGTH_NIL",TermC.num_str @{thm LENGTH_NIL}),
182 (* Rule.Thm ("list_diff_def",num_str @{thm list_diff_def}),*)
183 Rule.Thm ("map_Cons",TermC.num_str @{thm map_Cons}),
184 Rule.Thm ("map_Nil",TermC.num_str @{thm map_Cons}),
185 (* Rule.Thm ("mem_Cons",TermC.num_str @{thm mem_Cons}),
186 Rule.Thm ("mem_Nil",TermC.num_str @{thm mem_Nil}), *)
187 (* Rule.Thm ("null_Cons",TermC.num_str @{thm null_Cons}),
188 Rule.Thm ("null_Nil",TermC.num_str @{thm null_Nil}),*)
189 Rule.Thm ("remdups_Cons",TermC.num_str @{thm remdups_Cons}),
190 Rule.Thm ("remdups_Nil",TermC.num_str @{thm remdups_Nil}),
191 Rule.Thm ("rev_Cons",TermC.num_str @{thm rev_Cons}),
192 Rule.Thm ("rev_Nil",TermC.num_str @{thm rev_Nil}),
193 Rule.Thm ("take_Nil",TermC.num_str @{thm take_Nil}),
194 Rule.Thm ("take_Cons",TermC.num_str @{thm take_Cons}),
195 Rule.Thm ("tl_Cons",TermC.num_str @{thm tl_Cons}),
196 Rule.Thm ("tl_Nil",TermC.num_str @{thm tl_Nil}),
197 Rule.Thm ("zip_Cons",TermC.num_str @{thm zip_Cons}),
198 Rule.Thm ("zip_Nil",TermC.num_str @{thm zip_Nil})],
199 scr = Rule.EmptyScr}: Rule.rls;
201 setup \<open>KEStore_Elems.add_rlss [("list_rls", (Context.theory_name @{theory}, list_rls))]\<close>