wneuper@59586
|
1 |
(* Title: src/Tools/isac/KEStore.thy
|
wneuper@59586
|
2 |
Author: Mathias Lehnfeld
|
wneuper@59586
|
3 |
*)
|
wneuper@59586
|
4 |
|
wneuper@59586
|
5 |
theory KEStore imports Complex_Main
|
wneuper@59586
|
6 |
|
wneuper@59586
|
7 |
begin
|
wneuper@59586
|
8 |
ML_file libraryC.sml
|
walther@59848
|
9 |
ML_file "rule-def.sml"
|
wneuper@59586
|
10 |
ML_file rule.sml
|
walther@59850
|
11 |
ML_file "rule-set.sml"
|
wneuper@59586
|
12 |
ML_file calcelems.sml
|
wneuper@59586
|
13 |
ML \<open>
|
wneuper@59586
|
14 |
\<close> ML \<open>
|
wneuper@59587
|
15 |
\<close> ML \<open>
|
wneuper@59586
|
16 |
\<close>
|
wneuper@59586
|
17 |
section \<open>Knowledge elements for problems and methods\<close>
|
wneuper@59586
|
18 |
ML \<open>
|
wneuper@59586
|
19 |
(* Knowledge (and Exercises) are held by "KEStore" in Isac's Java front-end.
|
wneuper@59586
|
20 |
In the front-end Knowledge comprises theories, problems and methods.
|
wneuper@59586
|
21 |
Elements of problems and methods are defined in theories alongside
|
wneuper@59586
|
22 |
the development of respective language elements.
|
wneuper@59586
|
23 |
However, the structure of methods and problems is independent from theories'
|
wneuper@59586
|
24 |
deductive structure. Thus respective structures are built in Build_Thydata.thy.
|
wneuper@59586
|
25 |
|
wneuper@59586
|
26 |
Most elements of problems and methods are implemented in "Knowledge/", but some
|
wneuper@59586
|
27 |
of them are implemented in "ProgLang/" already; thus "KEStore.thy" got this
|
wneuper@59586
|
28 |
location in the directory structure.
|
wneuper@59586
|
29 |
|
wneuper@59586
|
30 |
get_* retrieves all * of the respective theory PLUS of all ancestor theories.
|
wneuper@59586
|
31 |
*)
|
wneuper@59586
|
32 |
signature KESTORE_ELEMS =
|
wneuper@59586
|
33 |
sig
|
walther@59852
|
34 |
val get_rlss: theory -> (Rule_Set.identifier * (Rule.theory' * Rule_Set.T)) list
|
walther@59852
|
35 |
val add_rlss: (Rule_Set.identifier * (Rule.theory' * Rule_Set.T)) list -> theory -> theory
|
walther@59850
|
36 |
val get_calcs: theory -> (Rule_Set.prog_calcID * (Rule.calID * Rule.eval_fn)) list
|
walther@59850
|
37 |
val add_calcs: (Rule_Set.prog_calcID * (Rule.calID * Rule.eval_fn)) list -> theory -> theory
|
wneuper@59586
|
38 |
val get_cas: theory -> Celem.cas_elem list
|
wneuper@59586
|
39 |
val add_cas: Celem.cas_elem list -> theory -> theory
|
wneuper@59586
|
40 |
val get_ptyps: theory -> Celem.ptyps
|
wneuper@59586
|
41 |
val add_pbts: (Celem.pbt * Celem.pblID) list -> theory -> theory
|
wneuper@59586
|
42 |
val get_mets: theory -> Celem.mets
|
wneuper@59586
|
43 |
val add_mets: (Celem.met * Celem.metID) list -> theory -> theory
|
wneuper@59586
|
44 |
val get_thes: theory -> (Celem.thydata Celem.ptyp) list
|
wneuper@59586
|
45 |
val add_thes: (Celem.thydata * Celem.theID) list -> theory -> theory (* thydata dropped at existing elems *)
|
wneuper@59586
|
46 |
val insert_fillpats: (Celem.theID * Celem.fillpat list) list -> theory -> theory
|
wneuper@59586
|
47 |
val get_ref_thy: unit -> theory
|
wneuper@59586
|
48 |
val set_ref_thy: theory -> unit
|
wneuper@59586
|
49 |
end;
|
wneuper@59586
|
50 |
|
wneuper@59586
|
51 |
structure KEStore_Elems: KESTORE_ELEMS =
|
wneuper@59586
|
52 |
struct
|
wneuper@59586
|
53 |
fun union_overwrite eq l1 l2 = fold (insert eq) l2 (*..swapped..*) l1;
|
wneuper@59586
|
54 |
|
wneuper@59586
|
55 |
structure Data = Theory_Data (
|
walther@59852
|
56 |
type T = (Rule_Set.identifier * (Rule.theory' * Rule_Set.T)) list;
|
wneuper@59586
|
57 |
val empty = [];
|
wneuper@59586
|
58 |
val extend = I;
|
walther@59852
|
59 |
val merge = Rule_Set.to_kestore;
|
wneuper@59586
|
60 |
);
|
wneuper@59586
|
61 |
fun get_rlss thy = Data.get thy
|
walther@59852
|
62 |
fun add_rlss rlss = Data.map (union_overwrite Rule_Set.equal rlss)
|
wneuper@59586
|
63 |
|
wneuper@59586
|
64 |
structure Data = Theory_Data (
|
walther@59850
|
65 |
type T = (Rule_Set.prog_calcID * (Rule.calID * Rule.eval_fn)) list;
|
wneuper@59586
|
66 |
val empty = [];
|
wneuper@59586
|
67 |
val extend = I;
|
walther@59850
|
68 |
val merge = merge Rule_Set.calc_eq;
|
wneuper@59586
|
69 |
);
|
wneuper@59586
|
70 |
fun get_calcs thy = Data.get thy
|
walther@59850
|
71 |
fun add_calcs calcs = Data.map (union_overwrite Rule_Set.calc_eq calcs)
|
wneuper@59586
|
72 |
|
wneuper@59586
|
73 |
structure Data = Theory_Data (
|
wneuper@59586
|
74 |
type T = (term * (Celem.spec * (term list -> (term * term list) list))) list;
|
wneuper@59586
|
75 |
val empty = [];
|
wneuper@59586
|
76 |
val extend = I;
|
wneuper@59586
|
77 |
val merge = merge Celem.cas_eq;
|
wneuper@59586
|
78 |
);
|
wneuper@59586
|
79 |
fun get_cas thy = Data.get thy
|
wneuper@59586
|
80 |
fun add_cas cas = Data.map (union_overwrite Celem.cas_eq cas)
|
wneuper@59586
|
81 |
|
wneuper@59586
|
82 |
structure Data = Theory_Data (
|
wneuper@59586
|
83 |
type T = Celem.ptyps;
|
wneuper@59586
|
84 |
val empty = [Celem.e_Ptyp];
|
wneuper@59586
|
85 |
val extend = I;
|
wneuper@59586
|
86 |
val merge = Celem.merge_ptyps;
|
wneuper@59586
|
87 |
);
|
wneuper@59586
|
88 |
fun get_ptyps thy = Data.get thy;
|
wneuper@59586
|
89 |
fun add_pbts pbts thy = let
|
wneuper@59586
|
90 |
fun add_pbt (pbt as {guh,...}, pblID) =
|
wneuper@59586
|
91 |
(* the pblID has the leaf-element as first; better readability achieved *)
|
wneuper@59586
|
92 |
(if (!Celem.check_guhs_unique) then Celem.check_pblguh_unique guh (Data.get thy) else ();
|
wneuper@59586
|
93 |
rev pblID |> Celem.insrt pblID pbt);
|
wneuper@59586
|
94 |
in Data.map (fold add_pbt pbts) thy end;
|
wneuper@59586
|
95 |
|
wneuper@59586
|
96 |
structure Data = Theory_Data (
|
wneuper@59586
|
97 |
type T = Celem.mets;
|
wneuper@59586
|
98 |
val empty = [Celem.e_Mets];
|
wneuper@59586
|
99 |
val extend = I;
|
wneuper@59586
|
100 |
val merge = Celem.merge_ptyps;
|
wneuper@59586
|
101 |
);
|
wneuper@59586
|
102 |
val get_mets = Data.get;
|
wneuper@59586
|
103 |
fun add_mets mets thy = let
|
wneuper@59586
|
104 |
fun add_met (met as {guh,...}, metID) =
|
wneuper@59586
|
105 |
(if (!Celem.check_guhs_unique) then Celem.check_metguh_unique guh (Data.get thy) else ();
|
wneuper@59586
|
106 |
Celem.insrt metID met metID);
|
wneuper@59586
|
107 |
in Data.map (fold add_met mets) thy end;
|
wneuper@59586
|
108 |
|
wneuper@59586
|
109 |
structure Data = Theory_Data (
|
wneuper@59586
|
110 |
type T = (Celem.thydata Celem.ptyp) list;
|
wneuper@59586
|
111 |
val empty = [];
|
wneuper@59586
|
112 |
val extend = I;
|
wneuper@59586
|
113 |
val merge = Celem.merge_ptyps; (* relevant for store_thm, store_rls *)
|
wneuper@59586
|
114 |
);
|
wneuper@59586
|
115 |
fun get_thes thy = Data.get thy
|
wneuper@59586
|
116 |
fun add_thes thes thy = let
|
wneuper@59586
|
117 |
fun add_the (thydata, theID) = Celem.add_thydata ([], theID) thydata
|
wneuper@59586
|
118 |
in Data.map (fold add_the thes) thy end;
|
wneuper@59586
|
119 |
fun insert_fillpats fis thy =
|
wneuper@59586
|
120 |
let
|
wneuper@59586
|
121 |
fun update_elem (theID, fillpats) =
|
wneuper@59586
|
122 |
let
|
wneuper@59586
|
123 |
val hthm = Celem.get_py (Data.get thy) theID theID
|
wneuper@59586
|
124 |
val hthm' = Celem.update_hthm hthm fillpats
|
wneuper@59586
|
125 |
handle ERROR _ =>
|
wneuper@59586
|
126 |
error ("insert_fillpats: " ^ strs2str theID ^ "must address a theorem")
|
wneuper@59586
|
127 |
in Celem.update_ptyps theID theID hthm' end
|
wneuper@59586
|
128 |
in Data.map (fold update_elem fis) thy end
|
wneuper@59586
|
129 |
|
wneuper@59586
|
130 |
val cur_thy = Synchronized.var "finally_knowledge_complete" @{theory};
|
wneuper@59586
|
131 |
fun set_ref_thy thy = Synchronized.change cur_thy (fn _ => thy); (* never RE-set ! *)
|
wneuper@59586
|
132 |
fun get_ref_thy () = Synchronized.value cur_thy;
|
wneuper@59586
|
133 |
end;
|
wneuper@59586
|
134 |
\<close>
|
wneuper@59586
|
135 |
|
wneuper@59586
|
136 |
section \<open>Re-use existing access functions for knowledge elements\<close>
|
wneuper@59586
|
137 |
text \<open>
|
wneuper@59586
|
138 |
The independence of problems' and methods' structure enforces the accesse
|
wneuper@59592
|
139 |
functions to use "Isac_Knowledge", the final theory which comprises all knowledge defined.
|
wneuper@59586
|
140 |
\<close>
|
wneuper@59586
|
141 |
ML \<open>
|
wneuper@59586
|
142 |
val get_ref_thy = KEStore_Elems.get_ref_thy;
|
wneuper@59586
|
143 |
|
walther@59852
|
144 |
fun assoc_rls (rls' : Rule_Set.identifier) =
|
wneuper@59592
|
145 |
case AList.lookup (op =) (KEStore_Elems.get_rlss (Rule.Thy_Info_get_theory "Isac_Knowledge")) rls' of
|
wneuper@59586
|
146 |
SOME (_, rls) => rls
|
wneuper@59586
|
147 |
| NONE => raise ERROR ("rls \""^ rls' ^ "\" missing in KEStore.\n" ^
|
wneuper@59586
|
148 |
"TODO exception hierarchy needs to be established.")
|
wneuper@59586
|
149 |
|
walther@59852
|
150 |
fun assoc_rls' thy (rls' : Rule_Set.identifier) =
|
wneuper@59586
|
151 |
case AList.lookup (op =) (KEStore_Elems.get_rlss thy) rls' of
|
wneuper@59586
|
152 |
SOME (_, rls) => rls
|
wneuper@59586
|
153 |
| NONE => raise ERROR ("rls \""^ rls' ^ "\" missing in KEStore.\n" ^
|
wneuper@59586
|
154 |
"TODO exception hierarchy needs to be established.")
|
wneuper@59586
|
155 |
|
wneuper@59586
|
156 |
fun assoc_calc thy calID = let
|
wneuper@59586
|
157 |
fun ass ([], key) =
|
wneuper@59586
|
158 |
error ("assoc_calc: '" ^ key ^ "' not found in theory " ^ (Context.theory_name thy))
|
wneuper@59586
|
159 |
| ass ((calc, (keyi, _)) :: pairs, key) =
|
wneuper@59586
|
160 |
if key = keyi then calc else ass (pairs, key);
|
wneuper@59586
|
161 |
in ass (thy |> KEStore_Elems.get_calcs, calID) end;
|
wneuper@59586
|
162 |
|
wneuper@59586
|
163 |
fun assoc_calc' thy key = let
|
wneuper@59586
|
164 |
fun ass ([], key') =
|
wneuper@59586
|
165 |
error ("assoc_calc': '" ^ key' ^ "' not found in theory " ^ (Context.theory_name thy))
|
wneuper@59586
|
166 |
| ass ((all as (keyi, _)) :: pairs, key') =
|
wneuper@59586
|
167 |
if key' = keyi then all else ass (pairs, key');
|
wneuper@59586
|
168 |
in ass (KEStore_Elems.get_calcs thy, key) end;
|
wneuper@59586
|
169 |
|
wneuper@59586
|
170 |
fun assoc_cas thy key = assoc (KEStore_Elems.get_cas thy, key);
|
wneuper@59586
|
171 |
|
wneuper@59586
|
172 |
fun get_ptyps () = get_ref_thy () |> KEStore_Elems.get_ptyps;
|
wneuper@59586
|
173 |
fun get_mets () = get_ref_thy () |> KEStore_Elems.get_mets;
|
wneuper@59586
|
174 |
fun get_thes () = get_ref_thy () |> KEStore_Elems.get_thes;
|
wneuper@59586
|
175 |
\<close>
|
wneuper@59586
|
176 |
setup \<open>KEStore_Elems.add_rlss
|
walther@59852
|
177 |
[("empty", (Context.theory_name @{theory}, Rule_Set.empty)),
|
walther@59850
|
178 |
("e_rrls", (Context.theory_name @{theory}, Rule_Set.e_rrls))]\<close>
|
wneuper@59586
|
179 |
|
wneuper@59586
|
180 |
section \<open>determine sequence of main parts in thehier\<close>
|
wneuper@59586
|
181 |
setup \<open>
|
wneuper@59586
|
182 |
KEStore_Elems.add_thes
|
wneuper@59586
|
183 |
[(Celem.Html {guh = Celem.part2guh ["IsacKnowledge"], html = "",
|
wneuper@59586
|
184 |
mathauthors = ["Isac team"], coursedesign = []}, ["IsacKnowledge"]),
|
wneuper@59586
|
185 |
(Celem.Html {guh = Celem.part2guh ["Isabelle"], html = "",
|
wneuper@59586
|
186 |
mathauthors = ["Isabelle team, TU Munich"], coursedesign = []}, ["Isabelle"]),
|
wneuper@59586
|
187 |
(Celem.Html {guh = Celem.part2guh ["IsacScripts"], html = "",
|
wneuper@59586
|
188 |
mathauthors = ["Isac team"], coursedesign = []}, ["IsacScripts"])]
|
wneuper@59586
|
189 |
\<close>
|
wneuper@59586
|
190 |
|
wneuper@59586
|
191 |
section \<open>Functions for checking KEStore_Elems\<close>
|
wneuper@59586
|
192 |
ML \<open>
|
walther@59851
|
193 |
fun short_string_of_rls Rule_Set.Empty = "Erls"
|
walther@59851
|
194 |
| short_string_of_rls (Rule_Def.Repeat {calc, rules, ...}) =
|
wneuper@59586
|
195 |
"Rls {#calc = " ^ string_of_int (length calc) ^
|
wneuper@59586
|
196 |
", #rules = " ^ string_of_int (length rules) ^ ", ..."
|
walther@59851
|
197 |
| short_string_of_rls (Rule_Set.Seqence {calc, rules, ...}) =
|
wneuper@59586
|
198 |
"Seq {#calc = " ^ string_of_int (length calc) ^
|
wneuper@59586
|
199 |
", #rules = " ^ string_of_int (length rules) ^ ", ..."
|
walther@59850
|
200 |
| short_string_of_rls (Rule_Set.Rrls _) = "Rrls {...}";
|
wneuper@59586
|
201 |
fun check_kestore_rls (rls', (thyID, rls)) =
|
wneuper@59586
|
202 |
"(" ^ rls' ^ ", (" ^ thyID ^ ", " ^ short_string_of_rls rls ^ "))";
|
wneuper@59586
|
203 |
|
walther@59852
|
204 |
fun check_kestore_calc ((id, (c, _)) : Rule_Def.calc) = "(" ^ id ^ ", (" ^ c ^ ", fn))";
|
wneuper@59586
|
205 |
|
walther@59846
|
206 |
(* we avoid term_to_string''' defined later *)
|
wneuper@59586
|
207 |
fun check_kestore_cas ((t, (s, _)) : Celem.cas_elem) =
|
walther@59846
|
208 |
"(" ^ (Print_Mode.setmp [] (Syntax.string_of_term (Config.put show_markup false
|
walther@59846
|
209 |
(Proof_Context.init_global @{theory})))) t ^ ", " ^ Celem.spec2str s ^ ")";
|
wneuper@59586
|
210 |
|
wneuper@59586
|
211 |
fun count_kestore_ptyps [] = 0
|
wneuper@59586
|
212 |
| count_kestore_ptyps ((Celem.Ptyp (_, _, ps)) :: ps') =
|
wneuper@59586
|
213 |
1 + count_kestore_ptyps ps + count_kestore_ptyps ps';
|
wneuper@59586
|
214 |
fun check_kestore_ptyp' strfun (Celem.Ptyp (key, pbts, pts)) = "Ptyp (" ^ (quote key) ^ ", " ^
|
wneuper@59586
|
215 |
(strfun pbts) ^ ", " ^ (map (check_kestore_ptyp' strfun) pts |> list2str) ^ ")" |> Celem.linefeed;
|
wneuper@59586
|
216 |
val check_kestore_ptyp = check_kestore_ptyp' Celem.pbts2str;
|
wneuper@59586
|
217 |
fun ptyp_ord ((Celem.Ptyp (s1, _, _)), (Celem.Ptyp (s2, _, _))) = string_ord (s1, s2);
|
wneuper@59586
|
218 |
fun pbt_ord ({guh = guh'1, ...} : Celem.pbt, {guh = guh'2, ...} : Celem.pbt) = string_ord (guh'1, guh'2);
|
wneuper@59586
|
219 |
fun sort_kestore_ptyp' _ [] = []
|
wneuper@59586
|
220 |
| sort_kestore_ptyp' ordfun ((Celem.Ptyp (key, pbts, ps)) :: ps') =
|
wneuper@59586
|
221 |
((Celem.Ptyp (key, sort ordfun pbts, sort_kestore_ptyp' ordfun ps |> sort ptyp_ord))
|
wneuper@59586
|
222 |
:: sort_kestore_ptyp' ordfun ps');
|
wneuper@59586
|
223 |
val sort_kestore_ptyp = sort_kestore_ptyp' pbt_ord;
|
wneuper@59586
|
224 |
|
wneuper@59586
|
225 |
fun metguh2str ({guh,...} : Celem.met) = guh : string;
|
wneuper@59586
|
226 |
fun check_kestore_met (mp: Celem.met Celem.ptyp) =
|
wneuper@59586
|
227 |
check_kestore_ptyp' (fn xs => map metguh2str xs |> strs2str) mp;
|
wneuper@59586
|
228 |
fun met_ord ({guh = guh'1, ...} : Celem.met, {guh = guh'2, ...} : Celem.met) = string_ord (guh'1, guh'2);
|
wneuper@59586
|
229 |
val sort_kestore_met = sort_kestore_ptyp' met_ord;
|
wneuper@59586
|
230 |
|
wneuper@59586
|
231 |
fun check_kestore_thes thes = ((map writeln) o (map (check_kestore_ptyp' Celem.thes2str))) thes
|
wneuper@59586
|
232 |
fun write_thes thydata_list =
|
wneuper@59586
|
233 |
thydata_list
|
wneuper@59586
|
234 |
|> map (fn (id, the) => (Celem.theID2str id, Celem.the2str the))
|
wneuper@59586
|
235 |
|> map pair2str
|
wneuper@59586
|
236 |
|> map writeln
|
wneuper@59586
|
237 |
\<close>
|
wneuper@59586
|
238 |
ML \<open>
|
wneuper@59586
|
239 |
\<close> ML \<open>
|
wneuper@59586
|
240 |
\<close> ML \<open>
|
wneuper@59586
|
241 |
\<close>
|
wneuper@59586
|
242 |
end
|