1 (* Title: tools for arithmetic
2 Author: Walther Neuper 010308
3 (c) due to copyright terms
5 12345678901234567890123456789012345678901234567890123456789012345678901234567890
6 10 20 30 40 50 60 70 80
9 theory Atools imports Descript
10 uses ("Interpret/mstools.sml")("Interpret/ctree.sml")("Interpret/ptyps.sml")
11 ("Interpret/generate.sml")("Interpret/calchead.sml")("Interpret/appl.sml")
12 ("Interpret/rewtools.sml")("Interpret/script.sml")("Interpret/solve.sml")
13 ("Interpret/inform.sml")("Interpret/mathengine.sml")
14 ("xmlsrc/mathml.sml")("xmlsrc/datatypes.sml")("xmlsrc/pbl-met-hierarchy.sml")
15 ("xmlsrc/thy-hierarchy.sml")("xmlsrc/interface-xml.sml")
16 ("Frontend/messages.sml")("Frontend/states.sml")("Frontend/interface.sml")
19 use "Interpret/mstools.sml"
20 use "Interpret/ctree.sml"
21 use "Interpret/ptyps.sml" (*^^^ need files for: fun prep_pbt, fun store_pbt*)
22 use "Interpret/generate.sml"
23 use "Interpret/calchead.sml"
24 use "Interpret/appl.sml"
25 use "Interpret/rewtools.sml"
26 use "Interpret/script.sml"
27 use "Interpret/solve.sml"
28 use "Interpret/inform.sml" (*^^^ need files for: fun castab*)
29 use "Interpret/mathengine.sml"
31 use "xmlsrc/mathml.sml"
32 use "xmlsrc/datatypes.sml"
33 use "xmlsrc/pbl-met-hierarchy.sml"
34 use "xmlsrc/thy-hierarchy.sml" (*^^^ need files for: fun store_isa*)
35 use "xmlsrc/interface-xml.sml"
37 use "Frontend/messages.sml"
38 use "Frontend/states.sml" (*^^^ need files for: val states in Test_Isac.thy*)
39 use "Frontend/interface.sml"
49 some'_occur'_in :: "[real list, 'a] => bool" ("some'_of _ occur'_in _")
50 occurs'_in :: "[real , 'a] => bool" ("_ occurs'_in _")
52 pow :: "[real, real] => real" (infixr "^^^" 80)
53 (* ~~~ power doesn't allow Free("2",real) ^ Free("2",nat)
55 (*WN0603 at FE-interface encoded strings to '^',
56 see 'fun encode', fun 'decode'*)
58 abs :: "real => real" ("(|| _ ||)")
59 (* ~~~ FIXXXME Isabelle2002 has abs already !!!*)
60 absset :: "real set => real" ("(||| _ |||)")
61 (*is numeral constant ?*)
62 is'_const :: "real => bool" ("_ is'_const" 10)
63 (*is_const rename to is_num FIXXXME.WN.16.5.03 *)
64 is'_atom :: "real => bool" ("_ is'_atom" 10)
65 is'_even :: "real => bool" ("_ is'_even" 10)
67 (* identity on term level*)
68 ident :: "['a, 'a] => bool" ("(_ =!=/ _)" [51, 51] 50)
70 argument'_in :: "real => real" ("argument'_in _" 10)
71 sameFunId :: "[real, bool] => bool" (**"same'_funid _ _" 10
72 WN0609 changed the id, because ".. _ _" inhibits currying**)
73 filter'_sameFunId:: "[real, bool list] => bool list"
74 ("filter'_sameFunId _ _" 10)
75 boollist2sum :: "bool list => real"
77 axioms (*for evaluating the assumptions of conditional rules*)
79 last_thmI: "lastI (x#xs) = (if xs =!= [] then x else lastI xs)"
80 real_unari_minus: "- a = (-1) * a"
82 rle_refl: "(n::real) <= n"
83 radd_left_cancel_le:"((k::real) + m <= k + n) = (m <= n)"
84 not_true: "(~ True) = False"
85 not_false: "(~ False) = True"
86 and_true: "(a & True) = a"
87 and_false: "(a & False) = False"
88 or_true: "(a | True) = True"
89 or_false: "(a | False) = a"
90 and_commute: "(a & b) = (b & a)"
91 or_commute: "(a | b) = (b | a)"
93 (*.should be in Rational.thy, but:
94 needed for asms in e.g. d2_pqformula1 in PolyEq.ML, RootEq.ML.*)
95 rat_leq1: "[| b ~= 0; d ~= 0 |] ==>
96 ((a / b) <= (c / d)) = ((a*d) <= (b*c))"(*Isa?*)
98 ( a <= (c / d)) = ((a*d) <= c )"(*Isa?*)
100 ((a / b) <= c ) = ( a <= (b*c))"(*Isa?*)
103 text {*copy from doc/math-eng.tex WN.28.3.03
106 section {*Coding standards*}
107 subsection {*Identifiers*}
108 text {*Naming is particularily crucial, because Isabelles name space is global, and isac does not yet use the novel locale features introduces by Isar. For instance, {\tt probe} sounds reasonable as (1) a description in the model of a problem-pattern, (2) as an element of the problem hierarchies key, (3) as a socalled CAS-command, (4) as the name of a related script etc. However, all the cases (1)..(4) require different typing for one and the same identifier {\tt probe} which is impossible, and actually leads to strange errors (for instance (1) is used as string, except in a script addressing a Subproblem).
110 This are the preliminary rules for naming identifiers>
112 \item [elements of a key] into the hierarchy of problems or methods must not contain capital letters and may contain underscrores, e.g. {\tt probe, for_polynomials}.
113 \item [descriptions in problem-patterns] must contain at least 1 capital letter and must not contain underscores, e.g. {\tt Probe, forPolynomials}.
114 \item [CAS-commands] follow the same rules as descriptions in problem-patterns above, thus beware of conflicts~!
115 \item [script identifiers] always end with {\tt Script}, e.g. {\tt ProbeScript}.
119 %WN071228 extended *}
121 subsection {*Rule sets*}
122 text {*The actual version of the coding standards for rulesets is in {\tt /IsacKnowledge/Atools.ML where it can be viewed using the knowledge browsers.
124 There are rulesets visible to the student, and there are rulesets visible (in general) only for math authors. There are also rulesets which {\em must} exist for {\em each} theory; these contain the identifier of the respective theory (including all capital letters) as indicated by {\it Thy} below.
127 \item [norm\_{\it Thy}] exists for each theory, and {\em efficiently} calculates a normalform for all terms which can be expressed by the definitions of the respective theory (and the respective parents).
129 \item [simplify\_{\it Thy}] exists for each theory, and calculates a normalform for all terms which can be expressed by the definitions of the respective theory (and the respective parents) such, that the rewrites can be presented to the student.
131 \item [calculate\_{\it Thy}] exists for each theory, and evaluates terms with numerical constants only (i.e. all terms which can be expressed by the definitions of the respective theory and the respective parent theories). In particular, this ruleset includes evaluating in/equalities with numerical constants only.
132 WN.3.7.03: may be dropped due to more generality: numericals and non-numericals are logically equivalent, where the latter often add to the assumptions (e.g. in Check_elementwise).
135 The above rulesets are all visible to the user, and also may be input; thus they must be contained in the global associationlist {\tt ruleset':= }~! All these rulesets must undergo a preparation using the function {\tt prep_rls}, which generates a script for stepwise rewriting etc.
136 The following rulesets are used for internal purposes and usually invisible to the (naive) user:
144 {\tt append_rls, merge_rls, remove_rls} TODO
150 (** evaluation of numerals and special predicates on the meta-level **)
151 (*-------------------------functions---------------------*)
152 local (* rlang 09.02 *)
153 (*.a 'c is coefficient of v' if v does occur in c.*)
154 fun coeff_in v c = member op = (vars c) v;
156 fun occurs_in v t = coeff_in v t;
159 (*("occurs_in", ("Atools.occurs'_in", eval_occurs_in ""))*)
160 fun eval_occurs_in _ "Atools.occurs'_in"
161 (p as (Const ("Atools.occurs'_in",_) $ v $ t)) _ =
162 ((*tracing("@@@ eval_occurs_in: v= "^(term2str v));
163 tracing("@@@ eval_occurs_in: t= "^(term2str t));*)
165 then SOME ((term2str p) ^ " = True",
166 Trueprop $ (mk_equality (p, HOLogic.true_const)))
167 else SOME ((term2str p) ^ " = False",
168 Trueprop $ (mk_equality (p, HOLogic.false_const))))
169 | eval_occurs_in _ _ _ _ = NONE;
171 (*some of the (bound) variables (eg. in an eqsys) "vs" occur in term "t"*)
172 fun some_occur_in vs t =
173 let fun occurs_in' a b = occurs_in b a
174 in foldl or_ (false, map (occurs_in' t) vs) end;
176 (*("some_occur_in", ("Atools.some'_occur'_in",
177 eval_some_occur_in "#eval_some_occur_in_"))*)
178 fun eval_some_occur_in _ "Atools.some'_occur'_in"
179 (p as (Const ("Atools.some'_occur'_in",_)
181 if some_occur_in (isalist2list vs) t
182 then SOME ((term2str p) ^ " = True",
183 Trueprop $ (mk_equality (p, HOLogic.true_const)))
184 else SOME ((term2str p) ^ " = False",
185 Trueprop $ (mk_equality (p, HOLogic.false_const)))
186 | eval_some_occur_in _ _ _ _ = NONE;
191 (*evaluate 'is_atom'*)
192 (*("is_atom",("Atools.is'_atom",eval_is_atom "#is_atom_"))*)
193 fun eval_is_atom (thmid:string) "Atools.is'_atom"
194 (t as (Const(op0,_) $ arg)) thy =
196 Free (n,_) => SOME (mk_thmid thmid op0 n "",
197 Trueprop $ (mk_equality (t, true_as_term)))
198 | _ => SOME (mk_thmid thmid op0 "" "",
199 Trueprop $ (mk_equality (t, false_as_term))))
200 | eval_is_atom _ _ _ _ = NONE;
202 (*evaluate 'is_even'*)
203 fun even i = (i div 2) * 2 = i;
204 (*("is_even",("Atools.is'_even",eval_is_even "#is_even_"))*)
205 fun eval_is_even (thmid:string) "Atools.is'_even"
206 (t as (Const(op0,_) $ arg)) thy =
209 (case int_of_str n of
211 if even i then SOME (mk_thmid thmid op0 n "",
212 Trueprop $ (mk_equality (t, true_as_term)))
213 else SOME (mk_thmid thmid op0 "" "",
214 Trueprop $ (mk_equality (t, false_as_term)))
217 | eval_is_even _ _ _ _ = NONE;
219 (*evaluate 'is_const'*)
220 (*("is_const",("Atools.is'_const",eval_const "#is_const_"))*)
221 fun eval_const (thmid:string) _(*"Atools.is'_const" WN050820 diff.beh. rooteq*)
222 (t as (Const(op0,t0) $ arg)) (thy:theory) =
223 (*eval_const FIXXXXXME.WN.16.5.03 still forgets ComplexI*)
226 SOME (mk_thmid thmid op0 n1 "",
227 Trueprop $ (mk_equality (t, false_as_term)))
230 then SOME (mk_thmid thmid op0 n1 "",
231 Trueprop $ (mk_equality (t, true_as_term)))
232 else SOME (mk_thmid thmid op0 n1 "",
233 Trueprop $ (mk_equality (t, false_as_term)))
234 | Const ("Float.Float",_) =>
235 SOME (mk_thmid thmid op0 (term2str arg) "",
236 Trueprop $ (mk_equality (t, true_as_term)))
238 SOME (mk_thmid thmid op0 (term2str arg) "",
239 Trueprop $ (mk_equality (t, false_as_term))))
240 | eval_const _ _ _ _ = NONE;
242 (*. evaluate binary, associative, commutative operators: *,+,^ .*)
243 (*("PLUS" ,("Groups.plus_class.plus" ,eval_binop "#add_")),
244 ("TIMES" ,("Groups.times_class.times" ,eval_binop "#mult_")),
245 ("POWER" ,("Atools.pow" ,eval_binop "#power_"))*)
247 (* val (thmid,op_,t as(Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2)),thy) =
248 ("xxxxxx",op_,t,thy);
250 fun mk_thmid_f thmid ((v11, v12), (p11, p12)) ((v21, v22), (p21, p22)) =
252 (string_of_int v11)^","^(string_of_int v12)^"), ("^
253 (string_of_int p11)^","^(string_of_int p12)^")) __ (("^
254 (string_of_int v21)^","^(string_of_int v22)^"), ("^
255 (string_of_int p21)^","^(string_of_int p22)^"))";
257 (*.convert int and float to internal floatingpoint prepresentation.*)
258 fun numeral (Free (str, T)) =
259 (case int_of_str str of
260 SOME i => SOME ((i, 0), (0, 0))
262 | numeral (Const ("Float.Float", _) $
264 (Const ("Pair", T) $ Free (v1, _) $ Free (v2,_)) $
265 (Const ("Pair", _) $ Free (p1, _) $ Free (p2,_))))=
266 (case (int_of_str v1, int_of_str v2, int_of_str p1, int_of_str p2) of
267 (SOME v1', SOME v2', SOME p1', SOME p2') =>
268 SOME ((v1', v2'), (p1', p2'))
272 (*.evaluate binary associative operations.*)
273 fun eval_binop (thmid:string) (op_:string)
274 (t as ( Const(op0,t0) $
275 (Const(op0',t0') $ v $ t1) $ t2))
276 thy = (*binary . (v.n1).n2*)
278 case (numeral t1, numeral t2) of
279 (SOME n1, SOME n2) =>
280 let val (T1,T2,Trange) = dest_binop_typ t0
281 val res = calc (if op0 = "Groups.minus_class.minus" then "Groups.plus_class.plus" else op0) n1 n2
282 (*WN071229 "Rings.inverse_class.divide" never tried*)
283 val rhs = var_op_float v op_ t0 T1 res
284 val prop = Trueprop $ (mk_equality (t, rhs))
285 in SOME (mk_thmid_f thmid n1 n2, prop) end
288 | eval_binop (thmid:string) (op_:string)
290 (Const (op0, t0) $ t1 $
291 (Const (op0', t0') $ t2 $ v)))
292 thy = (*binary . n1.(n2.v)*)
294 case (numeral t1, numeral t2) of
295 (SOME n1, SOME n2) =>
296 if op0 = "Groups.minus_class.minus" then NONE else
297 let val (T1,T2,Trange) = dest_binop_typ t0
298 val res = calc op0 n1 n2
299 val rhs = float_op_var v op_ t0 T1 res
300 val prop = Trueprop $ (mk_equality (t, rhs))
301 in SOME (mk_thmid_f thmid n1 n2, prop) end
305 | eval_binop (thmid:string) (op_:string)
306 (t as (Const (op0,t0) $ t1 $ t2)) thy = (*binary . n1.n2*)
307 (case (numeral t1, numeral t2) of
308 (SOME n1, SOME n2) =>
309 let val (T1,T2,Trange) = dest_binop_typ t0;
310 val res = calc op0 n1 n2;
311 val rhs = term_of_float Trange res;
312 val prop = Trueprop $ (mk_equality (t, rhs));
313 in SOME (mk_thmid_f thmid n1 n2, prop) end
315 | eval_binop _ _ _ _ = NONE;
317 > val SOME (thmid, t) = eval_binop "#add_" "Groups.plus_class.plus" (str2term "-1 + 2") thy;
319 val it = "-1 + 2 = 1"
320 > val t = str2term "-1 * (-1 * a)";
321 > val SOME (thmid, t) = eval_binop "#mult_" "Groups.times_class.times" t thy;
323 val it = "-1 * (-1 * a) = 1 * a"*)
327 (*.evaluate < and <= for numerals.*)
328 (*("le" ,("op <" ,eval_equ "#less_")),
329 ("leq" ,("op <=" ,eval_equ "#less_equal_"))*)
330 fun eval_equ (thmid:string) (op_:string) (t as
331 (Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2))) thy =
332 (case (int_of_str n1, int_of_str n2) of
333 (SOME n1', SOME n2') =>
334 if calc_equ (strip_thy op0) (n1', n2')
335 then SOME (mk_thmid thmid op0 n1 n2,
336 Trueprop $ (mk_equality (t, true_as_term)))
337 else SOME (mk_thmid thmid op0 n1 n2,
338 Trueprop $ (mk_equality (t, false_as_term)))
341 | eval_equ _ _ _ _ = NONE;
346 val it = "(?t = ?t) = True"
347 > val t = str2term "x = 0";
348 > val NONE = rewrite_ thy dummy_ord e_rls false reflI t;
350 > val t = str2term "1 = 0";
351 > val NONE = rewrite_ thy dummy_ord e_rls false reflI t;
352 ----------- thus needs Calc !
353 > val t = str2term "0 = 0";
354 > val SOME (t',_) = rewrite_ thy dummy_ord e_rls false reflI t;
358 val t = str2term "Not (x = 0)";
365 val it = "x ~= 0" : string*)
367 (*.evaluate identity on the term-level, =!= ,i.e. without evaluation of
368 the arguments: thus special handling by 'fun eval_binop'*)
369 (*("ident" ,("Atools.ident",eval_ident "#ident_")):calc*)
370 fun eval_ident (thmid:string) "Atools.ident" (t as
371 (Const (op0,t0) $ t1 $ t2 )) thy =
373 then SOME (mk_thmid thmid op0
374 ("("^(Syntax.string_of_term (thy2ctxt thy) t1)^")")
375 ("("^(Syntax.string_of_term (thy2ctxt thy) t2)^")"),
376 Trueprop $ (mk_equality (t, true_as_term)))
377 else SOME (mk_thmid thmid op0
378 ("("^(Syntax.string_of_term (thy2ctxt thy) t1)^")")
379 ("("^(Syntax.string_of_term (thy2ctxt thy) t2)^")"),
380 Trueprop $ (mk_equality (t, false_as_term)))
381 | eval_ident _ _ _ _ = NONE;
383 > val t = str2term "x =!= 0";
384 > val SOME (str, t') = eval_ident "ident_" "b" t thy;
386 val str = "ident_(x)_(0)" : string
387 val it = "(x =!= 0) = False" : string
388 > val t = str2term "1 =!= 0";
389 > val SOME (str, t') = eval_ident "ident_" "b" t thy;
391 val str = "ident_(1)_(0)" : string
392 val it = "(1 =!= 0) = False" : string
393 > val t = str2term "0 =!= 0";
394 > val SOME (str, t') = eval_ident "ident_" "b" t thy;
396 val str = "ident_(0)_(0)" : string
397 val it = "(0 =!= 0) = True" : string
400 (*.evaluate identity of terms, which stay ready for evaluation in turn;
401 thus returns False only for atoms.*)
402 (*("equal" ,("op =",eval_equal "#equal_")):calc*)
403 fun eval_equal (thmid:string) "op =" (t as
404 (Const (op0,t0) $ t1 $ t2 )) thy =
406 then ((*tracing"... eval_equal: t1 = t2 --> True";*)
407 SOME (mk_thmid thmid op0
408 ("("^(Syntax.string_of_term (thy2ctxt thy) t1)^")")
409 ("("^(Syntax.string_of_term (thy2ctxt thy) t2)^")"),
410 Trueprop $ (mk_equality (t, true_as_term)))
412 else (case (is_atom t1, is_atom t2) of
414 ((*tracing"... eval_equal: t1<>t2, is_atom t1,t2 --> False";*)
415 SOME (mk_thmid thmid op0
416 ("("^(term2str t1)^")") ("("^(term2str t2)^")"),
417 Trueprop $ (mk_equality (t, false_as_term)))
419 | _ => ((*tracing"... eval_equal: t1<>t2, NOT is_atom t1,t2 --> go-on";*)
421 | eval_equal _ _ _ _ = (tracing"... eval_equal: error-exit";
424 val t = str2term "x ~= 0";
425 val NONE = eval_equal "equal_" "b" t thy;
428 > val t = str2term "(x + 1) = (x + 1)";
429 > val SOME (str, t') = eval_equal "equal_" "b" t thy;
431 val str = "equal_(x + 1)_(x + 1)" : string
432 val it = "(x + 1 = x + 1) = True" : string
433 > val t = str2term "x = 0";
434 > val NONE = eval_equal "equal_" "b" t thy;
436 > val t = str2term "1 = 0";
437 > val SOME (str, t') = eval_equal "equal_" "b" t thy;
439 val str = "equal_(1)_(0)" : string
440 val it = "(1 = 0) = False" : string
441 > val t = str2term "0 = 0";
442 > val SOME (str, t') = eval_equal "equal_" "b" t thy;
444 val str = "equal_(0)_(0)" : string
445 val it = "(0 = 0) = True" : string
449 (** evaluation on the metalevel **)
451 (*. evaluate HOL.divide .*)
452 (*("DIVIDE" ,("Rings.inverse_class.divide" ,eval_cancel "#divide_e"))*)
453 fun eval_cancel (thmid:string) "Rings.inverse_class.divide" (t as
454 (Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2))) thy =
455 (case (int_of_str n1, int_of_str n2) of
456 (SOME n1', SOME n2') =>
458 val sg = sign2 n1' n2';
459 val (T1,T2,Trange) = dest_binop_typ t0;
460 val gcd' = gcd (abs n1') (abs n2');
462 then let val rhs = term_of_num Trange (sg * (abs n1') div gcd')
463 val prop = Trueprop $ (mk_equality (t, rhs))
464 in SOME (mk_thmid thmid op0 n1 n2, prop) end
465 else if 0 < n2' andalso gcd' = 1 then NONE
466 else let val rhs = num_op_num T1 T2 (op0,t0) (sg * (abs n1') div gcd')
468 val prop = Trueprop $ (mk_equality (t, rhs))
469 in SOME (mk_thmid thmid op0 n1 n2, prop) end
471 | _ => ((*tracing"@@@ eval_cancel NONE";*)NONE))
473 | eval_cancel _ _ _ _ = NONE;
475 (*. get the argument from a function-definition.*)
476 (*("argument_in" ,("Atools.argument'_in",
477 eval_argument_in "Atools.argument'_in"))*)
478 fun eval_argument_in _ "Atools.argument'_in"
479 (t as (Const ("Atools.argument'_in", _) $ (f $ arg))) _ =
480 if is_Free arg (*could be something to be simplified before*)
481 then SOME (term2str t ^ " = " ^ term2str arg,
482 Trueprop $ (mk_equality (t, arg)))
484 | eval_argument_in _ _ _ _ = NONE;
486 (*.check if the function-identifier of the first argument matches
487 the function-identifier of the lhs of the second argument.*)
488 (*("sameFunId" ,("Atools.sameFunId",
489 eval_same_funid "Atools.sameFunId"))*)
490 fun eval_sameFunId _ "Atools.sameFunId"
491 (p as Const ("Atools.sameFunId",_) $
493 (Const ("op =", _) $ (f2 $ _) $ _)) _ =
495 then SOME ((term2str p) ^ " = True",
496 Trueprop $ (mk_equality (p, HOLogic.true_const)))
497 else SOME ((term2str p) ^ " = False",
498 Trueprop $ (mk_equality (p, HOLogic.false_const)))
499 | eval_sameFunId _ _ _ _ = NONE;
502 (*.from a list of fun-definitions "f x = ..." as 2nd argument
503 filter the elements with the same fun-identfier in "f y"
505 this is, because Isabelles filter takes more than 1 sec.*)
506 fun same_funid f1 (Const ("op =", _) $ (f2 $ _) $ _) = f1 = f2
507 | same_funid f1 t = error ("same_funid called with t = ("
508 ^term2str f1^") ("^term2str t^")");
509 (*("filter_sameFunId" ,("Atools.filter'_sameFunId",
510 eval_filter_sameFunId "Atools.filter'_sameFunId"))*)
511 fun eval_filter_sameFunId _ "Atools.filter'_sameFunId"
512 (p as Const ("Atools.filter'_sameFunId",_) $
514 let val fs' = ((list2isalist HOLogic.boolT) o
515 (filter (same_funid fid))) (isalist2list fs)
516 in SOME (term2str (mk_equality (p, fs')),
517 Trueprop $ (mk_equality (p, fs'))) end
518 | eval_filter_sameFunId _ _ _ _ = NONE;
521 (*make a list of terms to a sum*)
522 fun list2sum [] = error ("list2sum called with []")
525 let fun sum su [s'] =
526 Const ("Groups.plus_class.plus", [HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
529 sum (Const ("Groups.plus_class.plus", [HOLogic.realT,HOLogic.realT]--->HOLogic.realT)
533 (*make a list of equalities to the sum of the lhs*)
534 (*("boollist2sum" ,("Atools.boollist2sum" ,eval_boollist2sum "")):calc*)
535 fun eval_boollist2sum _ "Atools.boollist2sum"
536 (p as Const ("Atools.boollist2sum", _) $
537 (l as Const ("List.list.Cons", _) $ _ $ _)) _ =
538 let val isal = isalist2list l
539 val lhss = map lhs isal
540 val sum = list2sum lhss
541 in SOME ((term2str p) ^ " = " ^ (term2str sum),
542 Trueprop $ (mk_equality (p, sum)))
544 | eval_boollist2sum _ _ _ _ = NONE;
553 fun termlessI (_:subst) uv = Term_Ord.termless uv;
554 fun term_ordI (_:subst) uv = Term_Ord.term_ord uv;
558 (** rule set, for evaluating list-expressions in scripts 8.01.02 **)
562 append_rls "list_rls" list_rls
563 [Calc ("Groups.times_class.times",eval_binop "#mult_"),
564 Calc ("Groups.plus_class.plus", eval_binop "#add_"),
565 Calc ("op <",eval_equ "#less_"),
566 Calc ("op <=",eval_equ "#less_equal_"),
567 Calc ("Atools.ident",eval_ident "#ident_"),
568 Calc ("op =",eval_equal "#equal_"),(*atom <> atom -> False*)
570 Calc ("Tools.Vars",eval_var "#Vars_"),
572 Thm ("if_True",num_str @{thm if_True}),
573 Thm ("if_False",num_str @{thm if_False})
576 ruleset' := overwritelthy thy (!ruleset',
577 [("list_rls",list_rls)
580 (*TODO.WN0509 reduce ids: tless_true = e_rew_ord' = e_rew_ord = dummy_ord*)
581 val tless_true = dummy_ord;
582 rew_ord' := overwritel (!rew_ord',
583 [("tless_true", tless_true),
584 ("e_rew_ord'", tless_true),
585 ("dummy_ord", dummy_ord)]);
587 val calculate_Atools =
588 append_rls "calculate_Atools" e_rls
589 [Calc ("op <",eval_equ "#less_"),
590 Calc ("op <=",eval_equ "#less_equal_"),
591 Calc ("op =",eval_equal "#equal_"),
593 Thm ("real_unari_minus",num_str @{thm real_unari_minus}),
594 Calc ("Groups.plus_class.plus",eval_binop "#add_"),
595 Calc ("Groups.minus_class.minus",eval_binop "#sub_"),
596 Calc ("Groups.times_class.times",eval_binop "#mult_")
600 append_rls "Atools_erls" e_rls
601 [Calc ("op =",eval_equal "#equal_"),
602 Thm ("not_true",num_str @{thm not_true}),
603 (*"(~ True) = False"*)
604 Thm ("not_false",num_str @{thm not_false}),
605 (*"(~ False) = True"*)
606 Thm ("and_true",num_str @{thm and_true}),
607 (*"(?a & True) = ?a"*)
608 Thm ("and_false",num_str @{thm and_false}),
609 (*"(?a & False) = False"*)
610 Thm ("or_true",num_str @{thm or_true}),
611 (*"(?a | True) = True"*)
612 Thm ("or_false",num_str @{thm or_false}),
613 (*"(?a | False) = ?a"*)
615 Thm ("rat_leq1",num_str @{thm rat_leq1}),
616 Thm ("rat_leq2",num_str @{thm rat_leq2}),
617 Thm ("rat_leq3",num_str @{thm rat_leq3}),
618 Thm ("refl",num_str @{thm refl}),
619 Thm ("real_le_refl",num_str @{thm real_le_refl}),
620 Thm ("radd_left_cancel_le",num_str @{thm radd_left_cancel_le}),
622 Calc ("op <",eval_equ "#less_"),
623 Calc ("op <=",eval_equ "#less_equal_"),
625 Calc ("Atools.ident",eval_ident "#ident_"),
626 Calc ("Atools.is'_const",eval_const "#is_const_"),
627 Calc ("Atools.occurs'_in",eval_occurs_in ""),
628 Calc ("Tools.matches",eval_matches "")
632 append_rls "Atools_crls" e_rls
633 [Calc ("op =",eval_equal "#equal_"),
634 Thm ("not_true",num_str @{thm not_true}),
635 Thm ("not_false",num_str @{thm not_false}),
636 Thm ("and_true",num_str @{thm and_true}),
637 Thm ("and_false",num_str @{thm and_false}),
638 Thm ("or_true",num_str @{thm or_true}),
639 Thm ("or_false",num_str @{thm or_false}),
641 Thm ("rat_leq1",num_str @{thm rat_leq1}),
642 Thm ("rat_leq2",num_str @{thm rat_leq2}),
643 Thm ("rat_leq3",num_str @{thm rat_leq3}),
644 Thm ("refl",num_str @{thm refl}),
645 Thm ("real_le_refl",num_str @{thm real_le_refl}),
646 Thm ("radd_left_cancel_le",num_str @{thm radd_left_cancel_le}),
648 Calc ("op <",eval_equ "#less_"),
649 Calc ("op <=",eval_equ "#less_equal_"),
651 Calc ("Atools.ident",eval_ident "#ident_"),
652 Calc ("Atools.is'_const",eval_const "#is_const_"),
653 Calc ("Atools.occurs'_in",eval_occurs_in ""),
654 Calc ("Tools.matches",eval_matches "")
657 (*val atools_erls = ... waere zu testen ...
658 merge_rls calculate_Atools
659 (append_rls Atools_erls (*i.A. zu viele rules*)
660 [Calc ("Atools.ident",eval_ident "#ident_"),
661 Calc ("Atools.is'_const",eval_const "#is_const_"),
662 Calc ("Atools.occurs'_in",
663 eval_occurs_in "#occurs_in"),
664 Calc ("Tools.matches",eval_matches "#matches")
665 ] (*i.A. zu viele rules*)
667 (* val atools_erls = prep_rls(
668 Rls {id="atools_erls",preconds = [], rew_ord = ("termlessI",termlessI),
669 erls = e_rls, srls = Erls, calc = [], (*asm_thm = [],*)
670 rules = [Thm ("refl",num_str @{thm refl}),
671 Thm ("real_le_refl",num_str @{thm real_le_refl}),
672 Thm ("radd_left_cancel_le",num_str @{thm radd_left_cancel_le}),
673 Thm ("not_true",num_str @{thm not_true}),
674 Thm ("not_false",num_str @{thm not_false}),
675 Thm ("and_true",num_str @{thm and_true}),
676 Thm ("and_false",num_str @{thm and_false}),
677 Thm ("or_true",num_str @{thm or_true}),
678 Thm ("or_false",num_str @{thm or_false}),
679 Thm ("and_commute",num_str @{thm and_commute}),
680 Thm ("or_commute",num_str @{thm or_commute}),
682 Calc ("op <",eval_equ "#less_"),
683 Calc ("op <=",eval_equ "#less_equal_"),
685 Calc ("Atools.ident",eval_ident "#ident_"),
686 Calc ("Atools.is'_const",eval_const "#is_const_"),
687 Calc ("Atools.occurs'_in",eval_occurs_in ""),
688 Calc ("Tools.matches",eval_matches "")
690 scr = Script ((term_of o the o (parse @{theory}))
693 ruleset' := overwritelth @{theory}
695 [("atools_erls",atools_erls)(*FIXXXME:del with rls.rls'*)
698 "******* Atools.ML end *******";
700 calclist':= overwritel (!calclist',
701 [("occurs_in",("Atools.occurs'_in", eval_occurs_in "#occurs_in_")),
703 ("Atools.some'_occur'_in", eval_some_occur_in "#some_occur_in_")),
704 ("is_atom" ,("Atools.is'_atom",eval_is_atom "#is_atom_")),
705 ("is_even" ,("Atools.is'_even",eval_is_even "#is_even_")),
706 ("is_const" ,("Atools.is'_const",eval_const "#is_const_")),
707 ("le" ,("op <" ,eval_equ "#less_")),
708 ("leq" ,("op <=" ,eval_equ "#less_equal_")),
709 ("ident" ,("Atools.ident",eval_ident "#ident_")),
710 ("equal" ,("op =",eval_equal "#equal_")),
711 ("PLUS" ,("Groups.plus_class.plus" ,eval_binop "#add_")),
712 ("MINUS" ,("Groups.minus_class.minus",eval_binop "#sub_")),
713 ("TIMES" ,("Groups.times_class.times" ,eval_binop "#mult_")),
714 ("DIVIDE" ,("Rings.inverse_class.divide" ,eval_cancel "#divide_e")),
715 ("POWER" ,("Atools.pow" ,eval_binop "#power_")),
716 ("boollist2sum",("Atools.boollist2sum",eval_boollist2sum ""))
719 val list_rls = prep_rls(
720 merge_rls "list_erls"
721 (Rls {id="replaced",preconds = [],
722 rew_ord = ("termlessI", termlessI),
723 erls = Rls {id="list_elrs", preconds = [],
724 rew_ord = ("termlessI",termlessI),
726 srls = Erls, calc = [], (*asm_thm = [],*)
727 rules = [Calc ("Groups.plus_class.plus", eval_binop "#add_"),
728 Calc ("op <",eval_equ "#less_")
729 (* ~~~~~~ for nth_Cons_*)
732 srls = Erls, calc = [], (*asm_thm = [], *)
733 rules = [], scr = EmptyScr})
735 ruleset' := overwritelthy @{theory} (!ruleset', [("list_rls", list_rls)]);