test/Tools/isac/Interpret/rewtools.sml
author Walther Neuper <neuper@ist.tugraz.at>
Thu, 23 Sep 2010 14:49:23 +0200
branchisac-update-Isa09-2
changeset 38014 3e11e3c2dc42
parent 37969 81922154e742
child 38031 460c24a6a6ba
permissions -rw-r--r--
updated "op +", "op -", "op *". "HOL.divide" in src & test

find . -type f -exec sed -i s/"\"op +\""/"\"Groups.plus_class.plus\""/g {} \;
find . -type f -exec sed -i s/"\"op -\""/"\"Groups.minus_class.minus\""/g {} \;
find . -type f -exec sed -i s/"\"op *\""/"\"Groups.times_class.times\""/g {} \;
find . -type f -exec sed -i s/"\"HOL.divide\""/"\"Rings.inverse_class.divide\""/g {} \;
neuper@37906
     1
(* test for sml/ME/rewtools.sml
neuper@37906
     2
   authors: Walther Neuper 2000, 2006
neuper@37906
     3
   (c) due to copyright terms
neuper@37906
     4
neuper@37906
     5
use"../smltest/ME/rewtools.sml";
neuper@37906
     6
use"rewtools.sml";
neuper@37906
     7
*)
neuper@37906
     8
neuper@37906
     9
"-----------------------------------------------------------------";
neuper@37906
    10
"table of contents -----------------------------------------------";
neuper@37906
    11
"-----------------------------------------------------------------";
neuper@37906
    12
"----------- fun collect_isab_thys -------------------------------";
neuper@37906
    13
"----------- fun thy_containing_thm ------------------------------";
neuper@37906
    14
"----------- fun thy_containing_rls ------------------------------";
neuper@37906
    15
"----------- fun thy_containing_cal ------------------------------";
neuper@37906
    16
"----------- initContext Thy_ Integration-demo -------------------";
neuper@37906
    17
"----------- initContext..Thy_, fun context_thm ------------------";
neuper@37906
    18
"----------- initContext..Thy_, fun context_rls ------------------";
neuper@37906
    19
"----------- checkContext..Thy_, fun context_thy -----------------";
neuper@37906
    20
"----------- checkContext..Thy_, fun context_rls -----------------";
neuper@37906
    21
"----------- checkContext..Thy_ on last formula ------------------"; 
neuper@37906
    22
"----------- fun guh2theID ---------------------------------------";
neuper@37906
    23
"----------- debugging on Tests/solve_linear_as_rootpbl ----------";
neuper@37906
    24
"-----------------------------------------------------------------";
neuper@37906
    25
"----------- fun string_of_thmI for_[.]_) ------------------------";
neuper@37906
    26
"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[.]_)-----";
neuper@37906
    27
"-----------------------------------------------------------------";
neuper@37906
    28
"----------- fun filter_appl_rews --------------------------------";
neuper@37906
    29
"----------- fun is_contained_in ---------------------------------";
neuper@37906
    30
"-----------------------------------------------------------------";
neuper@37906
    31
"-----------------------------------------------------------------";
neuper@37906
    32
neuper@37906
    33
neuper@37906
    34
neuper@37906
    35
"----------- fun collect_isab_thys -------------------------------";
neuper@37906
    36
"----------- fun collect_isab_thys -------------------------------";
neuper@37906
    37
"----------- fun collect_isab_thys -------------------------------";
neuper@37906
    38
val thy = first_isac_thy (*def. in Script/ListG.ML*); 
neuper@37906
    39
val {ancestors,...} = rep_theory thy;
neuper@37906
    40
print_depth 99; map string_of_thy ancestors; print_depth 3;
neuper@37906
    41
length ancestors;
neuper@37906
    42
val ancestors = (#ancestors o rep_theory) first_isac_thy;
neuper@37906
    43
length ancestors;
neuper@37906
    44
print_depth 99; map theory2theory' ancestors; print_depth 3;
neuper@37936
    45
val isabthms = (flat o (map PureThy.all_thms_of)) ancestors;
neuper@37906
    46
length isabthms;
neuper@37906
    47
neuper@37906
    48
val isacrules = (flat o (map (thms_of_rls o #2 o #2))) (!ruleset');
neuper@37906
    49
(*thms from rulesets*)
neuper@37906
    50
val isacrlsthms = ((map rep_thm_G') o flat o 
neuper@37936
    51
		(map (PureThy.all_thms_of_rls o #2 o #2))) (!ruleset');
neuper@37906
    52
length isacrlsthms;
neuper@37906
    53
(*takes a few seconds...
neuper@37906
    54
val isacrlsthms = gen_distinct eq_thmI isacrlsthms;
neuper@37906
    55
length isacrlsthms;
neuper@37906
    56
"----- theorems used in isac's rulesets -----vvvvvvvvvvvvvvvvvvvvv";
neuper@37906
    57
print_depth 99; map #1 isacrlsthms; print_depth 3;
neuper@37906
    58
"----- theorems used in isac's rulesets -----^^^^^^^^^^^^^^^^^^^^^";
neuper@37906
    59
...*)
neuper@37906
    60
neuper@37906
    61
(!theory');
neuper@37906
    62
map #2 (!theory');
neuper@37936
    63
map (PureThy.all_thms_of o #2) (!theory');
neuper@37936
    64
val isacthms = (flat o (map (PureThy.all_thms_of o #2))) (!theory');
neuper@37906
    65
(*takes a few seconds...
neuper@37906
    66
val rlsthmsNOTisac = gen_diff eq_thmI (isacrlsthms, isacthms);
neuper@37906
    67
length rlsthmsNOTisac;
neuper@37906
    68
"----- theorems from rulesets NOT def. in isac -----vvvvvvvvvvvvvv";
neuper@37906
    69
print_depth 99; map #1 rlsthmsNOTisac; print_depth 3;
neuper@37906
    70
"----- theorems from rulesets NOT def. in isac -----^^^^^^^^^^^^^^";
neuper@37906
    71
...*)
neuper@37906
    72
neuper@37906
    73
"----- for 'fun make_isab_thm_thy'";
neuper@37936
    74
inter eq_thmI isacrlsthms (PureThy.all_thms_of (nth 1 ancestors));
neuper@37936
    75
inter eq_thmI;
neuper@37936
    76
(inter eq_thmI);
neuper@37936
    77
(inter eq_thmI) isacrlsthms;
neuper@37906
    78
(*takes a few seconds...
neuper@37936
    79
curry (inter eq_thmI) isacrlsthms (PureThy.all_thms_of (nth 9 ancestors));
neuper@37906
    80
neuper@37906
    81
val thy = (nth 52 ancestors);
neuper@37936
    82
val sec = ((inter eq_thmI) isacrlsthms o PureThy.all_thms_of) (nth 52 ancestors);
neuper@37936
    83
length (PureThy.all_thms_of (nth 9 ancestors));
neuper@37906
    84
length sec;
neuper@37906
    85
...*)
neuper@37906
    86
neuper@37906
    87
(*takes 1 minute...
neuper@37906
    88
print_depth 99; 
neuper@37936
    89
map ((inter eq_thmI) rlsthmsNOTisac o PureThy.all_thms_of) ancestors;
neuper@37906
    90
print_depth 3;
neuper@37906
    91
*)
neuper@37906
    92
neuper@37906
    93
(*takes some seconds...
neuper@37906
    94
val isab_thm_thy = (flat o (map (make_isab_thm_thy rlsthmsNOTisac)))
neuper@37906
    95
		       ((#ancestors o rep_theory) first_isac_thy);
neuper@37906
    96
print_depth 99; isab_thm_thy; print_depth 3;
neuper@37906
    97
*)
neuper@37906
    98
neuper@37906
    99
neuper@37906
   100
"----------- fun thy_containing_thm ------------------------------";
neuper@37906
   101
"----------- fun thy_containing_thm ------------------------------";
neuper@37906
   102
"----------- fun thy_containing_thm ------------------------------";
neuper@37906
   103
val (str, (thy', thy)) = ("real_diff_minus",("Root.thy", Root.thy));
neuper@37906
   104
if thy_contains_thm str ("XXX",thy) then ()
neuper@37906
   105
else raise error "rewtools.sml: NOT thy_contains_thm \
neuper@37906
   106
		 \(real_diff_minus,(Root.thy,.";
neuper@37906
   107
(rev (!theory'));
neuper@37906
   108
dropuntil (curry op= thy');
neuper@37906
   109
dropuntil ((curry op= thy') o (#1:theory' * theory -> theory'));
neuper@37906
   110
val startsearch = dropuntil ((curry op= thy') o 
neuper@37906
   111
			     (#1:theory' * theory -> theory')) 
neuper@37906
   112
			    (rev (!theory'));
neuper@37906
   113
if thy_containing_thm thy' str = ("IsacKnowledge", "Root.thy") then ()
neuper@37906
   114
else raise error "rewtools.sml: NOT thy_containin_thm \
neuper@37906
   115
		 \(real_diff_minus,(Root.thy,.";
neuper@37906
   116
neuper@37906
   117
"----- search the same theorem somewhere further below in the list";
neuper@37906
   118
if thy_contains_thm str ("XXX",Poly.thy) then ()
neuper@37906
   119
else raise error "rewtools.sml: NOT thy_contains_thm \
neuper@37906
   120
		 \(real_diff_minus,(Poly.thy,.";
neuper@37906
   121
if thy_containing_thm "LinEq.thy" str = ("IsacKnowledge", "Poly.thy") then ()
neuper@37906
   122
else raise error "rewtools.sml: NOT thy_containing_thm \
neuper@37906
   123
		 \(real_diff_minus,(Poly.thy,.";
neuper@37906
   124
neuper@37906
   125
"----- second test -------------------------------";
neuper@37906
   126
show_thes();
neuper@37906
   127
(*args vor thy_containing_thm...*)
neuper@37906
   128
val (thy',str) = ("Test.thy", "radd_commute");
neuper@37906
   129
val startsearch = dropuntil ((curry op= thy') o 
neuper@37906
   130
				     (#1:theory' * theory -> theory')) 
neuper@37906
   131
				    (rev (!theory'));
neuper@37906
   132
length (!theory');
neuper@37906
   133
length startsearch;
neuper@37906
   134
if thy_containing_thm thy' str = ("IsacKnowledge", "Test.thy") then ()
neuper@37906
   135
else raise error "rewtools.sml: diff.behav. in \
neuper@37906
   136
		 \thy_containing_thm Test radd_commute";
neuper@37906
   137
neuper@37906
   138
neuper@37906
   139
"----------- fun thy_containing_rls ------------------------------";
neuper@37906
   140
"----------- fun thy_containing_rls ------------------------------";
neuper@37906
   141
"----------- fun thy_containing_rls ------------------------------";
neuper@37906
   142
val thy' = "Biegelinie.thy";
neuper@37906
   143
val dropthys = takewhile [] (not o (curry op= thy') o 
neuper@37906
   144
			     (#1:theory' * theory -> theory')) 
neuper@37906
   145
			 (rev (!theory'));
neuper@37906
   146
if length (!theory') <> length dropthys then ()
neuper@37906
   147
else raise error "rewtools.sml: diff.behav. in thy_containing_rls 1";
neuper@37906
   148
val dropthy's = map (get_thy o (#1 : (theory' * theory) -> theory'))
neuper@37906
   149
		    dropthys;
neuper@37906
   150
print_depth 99; dropthy's; print_depth 3;
neuper@37906
   151
neuper@37930
   152
(*WN100819========================================================
neuper@37906
   153
"Isac" mem dropthy's;
neuper@37906
   154
op mem ("Isac", dropthy's);
neuper@37906
   155
(op mem) o swap;
neuper@37906
   156
((op mem) o swap) (dropthy's, "Isac");
neuper@37906
   157
curry ((op mem) o swap);
neuper@37906
   158
curry ((op mem) o swap) dropthy's "Isac";
neuper@37906
   159
val startsearch = filter_out ((curry ((op mem) o swap) dropthy's) o	 
neuper@37906
   160
			      ((#1 o #2) : rls' * (theory' * rls) -> theory'))
neuper@37906
   161
			     (rev (!ruleset'));
neuper@37906
   162
print_depth 99; map (#1 o #2) startsearch; print_depth 3;
neuper@37906
   163
if length (!ruleset') <> length startsearch then ()
neuper@37906
   164
else raise error "rewtools.sml: diff.behav. in thy_containing_rls 2";
neuper@37906
   165
neuper@37906
   166
val rls' = "norm_Poly";
neuper@37906
   167
case assoc (startsearch, rls') of
neuper@37926
   168
    SOME (thy', _) => thyID2theory' thy'
neuper@37906
   169
  | _ => raise error ("thy_containing_rls : rls '"^str^
neuper@37906
   170
			  "' not in !rulset' und thy '"^thy'^"'");
neuper@37906
   171
neuper@37906
   172
if thy_containing_rls thy' rls' = ("IsacKnowledge", "Poly.thy") then ()
neuper@37906
   173
else raise error "rewtools.sml: diff.behav. in thy_containing_rls 3";
neuper@37906
   174
neuper@37906
   175
neuper@37906
   176
"----------- fun thy_containing_cal ------------------------------";
neuper@37906
   177
"----------- fun thy_containing_cal ------------------------------";
neuper@37906
   178
"----------- fun thy_containing_cal ------------------------------";
neuper@37906
   179
val thy' = "Atools.thy";
neuper@37906
   180
val dropthys = takewhile [] (not o (curry op= thy') o 
neuper@37906
   181
			     (#1:theory' * theory -> theory')) 
neuper@37906
   182
			 (rev (!theory'));
neuper@37906
   183
length dropthys <> length (!theory');
neuper@37906
   184
val dropthy's = map (get_thy o (#1 : (theory' * theory) -> theory'))
neuper@37906
   185
		    dropthys;
neuper@37906
   186
neuper@37906
   187
(rev (!calclist'));
neuper@37906
   188
map #1 (rev (!calclist'));
neuper@37906
   189
map (#1 : calc -> string) (rev (!calclist'));
neuper@37906
   190
val startsearch = filter_out ((curry ((op mem) o swap) dropthy's) o
neuper@37906
   191
			      (#1 : calc -> string)) (rev (!calclist'));
neuper@37930
   192
========================================================WN100819*)
neuper@37906
   193
neuper@37906
   194
"----------- initContext Thy_ Integration-demo -------------------";
neuper@37906
   195
"----------- initContext Thy_ Integration-demo -------------------";
neuper@37906
   196
"----------- initContext Thy_ Integration-demo -------------------";
neuper@37906
   197
states:=[];
neuper@37906
   198
CalcTree
neuper@37906
   199
[(["functionTerm (2 * x)","integrateBy x","antiDerivative FF"], 
neuper@37906
   200
  ("Integrate.thy",["integrate","function"],
neuper@37906
   201
  ["diff","integration"]))];
neuper@37906
   202
Iterator 1;
neuper@37906
   203
moveActiveRoot 1;
neuper@37906
   204
(*TODO.new_c: cvs before 071227, 11:50------------------
neuper@37906
   205
autoCalculate 1 CompleteCalc;
neuper@37906
   206
interSteps 1 ([1],Res);
neuper@37906
   207
interSteps 1 ([1,1],Res);
neuper@37906
   208
val ((pt,p),_) = get_calc 1; show_pt pt;
neuper@37906
   209
if existpt' ([1,1,1], Frm) pt then ()
neuper@37906
   210
else raise error "integrate.sml: interSteps on Rewrite_Set_Inst 1";
neuper@37906
   211
neuper@37906
   212
initContext  1 Thy_ ([1,1,1], Frm);
neuper@37906
   213
--------------------TODO.new_c: cvs before 071227, 11:50*)
neuper@37906
   214
neuper@37906
   215
"----------- initContext..Thy_, fun context_thm ------------------";
neuper@37906
   216
"----------- initContext..Thy_, fun context_thm ------------------";
neuper@37906
   217
"----------- initContext..Thy_, fun context_thm ------------------";
neuper@37906
   218
states:=[];
neuper@37906
   219
CalcTree      (*start of calculation, return No.1*)
neuper@37906
   220
[(["equality (x+1=2)", "solveFor x","solutions L"], 
neuper@37906
   221
  ("Test.thy", 
neuper@37906
   222
   ["sqroot-test","univariate","equation","test"],
neuper@37906
   223
   ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   224
Iterator 1; moveActiveRoot 1;
neuper@37906
   225
autoCalculate 1 CompleteCalc;
neuper@37906
   226
neuper@37906
   227
"----- no thy-context at result -----";
neuper@37906
   228
val p = ([], Res);
neuper@37906
   229
initContext 1 Thy_ p;
neuper@37906
   230
neuper@37906
   231
neuper@37906
   232
interSteps 1 ([2], Res);
neuper@37906
   233
interSteps 1 ([3,1], Res);
neuper@37906
   234
val ((pt,_),_) = get_calc 1; show_pt pt;
neuper@37906
   235
neuper@37906
   236
val p = ([2,4], Res);
neuper@37906
   237
val tac = Rewrite ("radd_left_commute","");
neuper@37906
   238
initContext 1 Thy_ p;
neuper@37906
   239
(*Res->Res, Rewrite "radd_left_commute 1 + (-2 + x) = 0 -> -2 + (1 + x) = 0
neuper@37906
   240
  --- in initContext..Thy_ ---*)
neuper@37906
   241
val ContThm {thm,result,...} = context_thy (pt,p) tac;
neuper@37906
   242
if thm = "thy_isac_Test-thm-radd_left_commute" 
neuper@37906
   243
   andalso term2str result = "-2 + (1 + x) = 0" then ()
neuper@37906
   244
else raise error"rewtools.sml initContext..Th_ thy_Test-thm-radd_left_commute";
neuper@37906
   245
neuper@37906
   246
val p = ([3,1,1], Frm);
neuper@37906
   247
val tac = Rewrite_Inst (["(bdv, x)"],("risolate_bdv_add",""));
neuper@37906
   248
initContext 1 Thy_ p;
neuper@37906
   249
(*Frm->Res, Rewrite_Inst "risolate_bdv_add"  -1 + x = 0 -> x = 0 + -1 * -1
neuper@37906
   250
  --- in initContext..Thy_ ---*)
neuper@37906
   251
val ContThmInst {thm,result,...} = context_thy (pt,p) tac;
neuper@37906
   252
if thm =  "thy_isac_Test-thm-risolate_bdv_add"
neuper@37906
   253
   andalso term2str result = "x = 0 + -1 * -1" then ()
neuper@37906
   254
else raise error "rewtools.sml initContext..Th_ thy_Test-thm-risolate_bdv_add";
neuper@37906
   255
neuper@37906
   256
initContext 1 Thy_ ([2,5], Res);
neuper@37906
   257
(*Res->Res, Calculate "plus"  -2 + (1 + x) = 0 -> -1 + x = 0
neuper@37906
   258
  --- in initContext..Thy_ ---*)
neuper@37906
   259
neuper@37906
   260
neuper@37906
   261
"----------- initContext..Thy_, fun context_rls ------------------";
neuper@37906
   262
"----------- initContext..Thy_, fun context_rls ------------------";
neuper@37906
   263
"----------- initContext..Thy_, fun context_rls ------------------";
neuper@37906
   264
(*using pt from above*)
neuper@37906
   265
val p = ([1], Res);
neuper@37906
   266
val tac = Rewrite_Set "Test_simplify";
neuper@37906
   267
initContext 1 Thy_ p;
neuper@37906
   268
(*Res->Res, Rewrite_Set "Test_simplify" x + 1 + -1 * 2 = 0 -> -1 + x = 0
neuper@37906
   269
  --- in initContext..Thy_ ---*)
neuper@37906
   270
val ContRls {rls,result,...} = context_thy (pt,p) tac;
neuper@37906
   271
if rls = "thy_isac_Test-rls-Test_simplify" 
neuper@37906
   272
   andalso term2str result = "-1 + x = 0" then ()
neuper@37906
   273
else raise error "rewtools.sml initContext..Th_ thy_Test-thm-risolate_bdv_add";
neuper@37906
   274
neuper@37906
   275
val p = ([3,1], Frm);
neuper@37906
   276
val tac = Rewrite_Set_Inst (["(bdv, x)"],"isolate_bdv");
neuper@37906
   277
initContext 1 Thy_ p;
neuper@37906
   278
(*Frm->Res, Rewrite_Set_Inst "isolate_bdv" -1 + x = 0 ->  x = 0 + -1 * -1
neuper@37906
   279
  --- in initContext..Thy_ ---*)
neuper@37906
   280
val ContRlsInst {rls,result,...} = context_thy (pt,p) tac;
neuper@37906
   281
if rls =  "thy_isac_Test-rls-isolate_bdv"
neuper@37906
   282
   andalso term2str result = "x = 0 + -1 * -1" then ()
neuper@37906
   283
else raise error "rewtools.sml initContext..Th_ thy_Test-thm-risolate_bdv_add";
neuper@37906
   284
neuper@37906
   285
neuper@37906
   286
neuper@37906
   287
"----------- checkContext..Thy_, fun context_thy -----------------";
neuper@37906
   288
"----------- checkContext..Thy_, fun context_thy -----------------";
neuper@37906
   289
"----------- checkContext..Thy_, fun context_thy -----------------";
neuper@37906
   290
(*using pt from above*)
neuper@37906
   291
neuper@37906
   292
val p = ([2,4], Res);
neuper@37906
   293
val tac = Rewrite ("radd_left_commute","");
neuper@37906
   294
checkContext 1 p "thy_Test-thm-radd_left_commute";
neuper@37906
   295
(* radd_left_commute: 1 + (-2 + x) = 0 -> -2 + (1 + x) = 0
neuper@37906
   296
  --- in checkContext..Thy_ ---*)
neuper@37906
   297
val ContThm {thm,result,...} = context_thy (pt,p) tac;
neuper@37906
   298
if thm =  "thy_isac_Test-thm-radd_left_commute"
neuper@37906
   299
   andalso term2str result = "-2 + (1 + x) = 0" then ()
neuper@37906
   300
else raise error "rewtools.sml checkContext.._ thy_Test-thm-radd_left_commute";
neuper@37906
   301
neuper@37906
   302
val p = ([3,1,1], Frm);
neuper@37906
   303
val tac = Rewrite_Inst (["(bdv,x)"],("risolate_bdv_add",""));
neuper@37906
   304
checkContext 1 p "thy_Test-thm-risolate_bdv_add";
neuper@37906
   305
(* risolate_bdv_add:  -1 + x = 0 -> x = 0 + -1 * -1
neuper@37906
   306
  --- in checkContext..Thy_ ---*)
neuper@37906
   307
val ContThmInst {thm,result,...} = context_thy (pt,p) tac;
neuper@37906
   308
if thm =  "thy_isac_Test-thm-risolate_bdv_add"
neuper@37906
   309
   andalso term2str result = "x = 0 + -1 * -1" then ()
neuper@37906
   310
else raise error "rewtools.sml checkContext..T_ thy_Test-thm-risolate_bdv_add";
neuper@37906
   311
neuper@37906
   312
val p = ([2,5], Res);
neuper@37906
   313
val tac = Calculate "plus";
neuper@37906
   314
(*checkContext..Thy_ 1 ([2,5], Res);*)
neuper@37906
   315
(*FIXXXME #######################vvvvv kestoreID !!!!!!!!!!!!!!!!*)
neuper@37906
   316
checkContext 1 p ;
neuper@37906
   317
(* Calculate "plus"  -2 + (1 + x) = 0 -> -1 + x = 0
neuper@37906
   318
  --- in checkContext..Thy_ ---*)
neuper@37906
   319
neuper@37906
   320
neuper@37906
   321
"----------- checkContext..Thy_, fun context_rls -----------------";
neuper@37906
   322
"----------- checkContext..Thy_, fun context_rls -----------------";
neuper@37906
   323
"----------- checkContext..Thy_, fun context_rls -----------------";
neuper@37906
   324
(*using pt from above*)
neuper@37906
   325
show_pt pt;
neuper@37906
   326
neuper@37906
   327
val p = ([1], Res);
neuper@37906
   328
val tac = Rewrite_Set "Test_simplify";
neuper@37906
   329
checkContext 1 p "thy_isac_Test-rls-Test_simplify";
neuper@37906
   330
(*Res->Res, Rewrite_Set "Test_simplify" x + 1 + -1 * 2 = 0 -> -1 + x = 0
neuper@37906
   331
  --- in checkContext..Thy_ ---*)
neuper@37906
   332
val ContRls {rls,result,...} = context_thy (pt,p) tac;
neuper@37906
   333
if rls = "thy_isac_Test-rls-Test_simplify" 
neuper@37906
   334
   andalso term2str result = "-1 + x = 0" then ()
neuper@37906
   335
else raise error "rewtools.sml checkContext..Thy_ thy_Test-rls-Test_simplify";
neuper@37906
   336
neuper@37906
   337
val p = ([3,1], Frm);
neuper@37906
   338
val tac = Rewrite_Set_Inst (["(bdv, x)"],"isolate_bdv");
neuper@37906
   339
checkContext 1 p "thy_Test-rls-isolate_bdv";
neuper@37906
   340
val ContRlsInst {rls,result,...} = context_thy (pt,p) tac;
neuper@37906
   341
if rls = "thy_isac_Test-rls-isolate_bdv" 
neuper@37906
   342
   andalso term2str result = "x = 0 + -1 * -1" then ()
neuper@37906
   343
else raise error "rewtools.sml checkContext..Thy_ thy_Test-thm-isolate_bdv";
neuper@37906
   344
neuper@37906
   345
neuper@37906
   346
"----------- checkContext..Thy_ on last formula ------------------"; 
neuper@37906
   347
"----------- checkContext..Thy_ on last formula ------------------"; 
neuper@37906
   348
"----------- checkContext..Thy_ on last formula ------------------"; 
neuper@37906
   349
states:=[];
neuper@37906
   350
CalcTree      (*start of calculation, return No.1*)
neuper@37906
   351
[(["equality (x+1=2)", "solveFor x","solutions L"], 
neuper@37906
   352
  ("Test.thy", 
neuper@37906
   353
   ["sqroot-test","univariate","equation","test"],
neuper@37906
   354
   ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   355
Iterator 1; moveActiveRoot 1;
neuper@37906
   356
neuper@37906
   357
autoCalculate 1 CompleteCalcHead;
neuper@37906
   358
autoCalculate 1 (Step 1);
neuper@37906
   359
val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
neuper@37906
   360
initContext 1 Thy_ ([1], Frm);
neuper@37906
   361
checkContext 1 ([1], Frm) "thy_isac_Test-thm-radd_left_commute";
neuper@37906
   362
neuper@37906
   363
autoCalculate 1 (Step 1);
neuper@37906
   364
val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
neuper@37906
   365
initContext 1 Thy_ ([1], Res);
neuper@37906
   366
checkContext 1 ([1], Res) "thy_isac_Test-rls-Test_simplify";
neuper@37906
   367
neuper@37906
   368
neuper@37906
   369
neuper@37906
   370
"----------- fun guh2theID ---------------------------------------";
neuper@37906
   371
"----------- fun guh2theID ---------------------------------------";
neuper@37906
   372
"----------- fun guh2theID ---------------------------------------";
neuper@37906
   373
val guh = "thy_scri_ListG-thm-zip_Nil";
neuper@37906
   374
neuper@37906
   375
take_fromto 1 4 (explode guh);
neuper@37906
   376
take_fromto 5 9 (explode guh);
neuper@37906
   377
val rest = takerest (9,(explode guh)); 
neuper@37906
   378
neuper@37906
   379
separate "-" rest;
neuper@37906
   380
space_implode "-" rest;
neuper@37906
   381
commas rest;
neuper@37906
   382
neuper@37906
   383
val delim = "-";
neuper@37906
   384
val thyID = takewhile [] (not o (curry op= delim)) rest;
neuper@37906
   385
val rest' = dropuntil (curry op= delim) rest;
neuper@37906
   386
val setc = take_fromto 1 5 rest';
neuper@37906
   387
val xstr = takerest (5, rest');
neuper@37906
   388
neuper@37906
   389
if guh2theID guh = ["IsacScripts", "ListG", "Theorems", "zip_Nil"] then ()
neuper@37906
   390
else raise error "rewtools.sml: guh2theID thy_scri_ListG-thm-zip_Nil changed";
neuper@37906
   391
neuper@37906
   392
neuper@37906
   393
"----------- debugging on Tests/solve_linear_as_rootpbl ----------";
neuper@37906
   394
"----------- debugging on Tests/solve_linear_as_rootpbl ----------";
neuper@37906
   395
"----------- debugging on Tests/solve_linear_as_rootpbl ----------";
neuper@37906
   396
"----- initContext -----";
neuper@37906
   397
states:=[];
neuper@37906
   398
CalcTree 
neuper@37906
   399
    [(["equality (1+-1*2+x=0)", "solveFor x", "solutions L"],
neuper@37906
   400
      ("Test.thy",
neuper@37906
   401
       ["linear","univariate","equation","test"],
neuper@37906
   402
       ["Test","solve_linear"]))];
neuper@37906
   403
Iterator 1; moveActiveRoot 1;
neuper@37906
   404
autoCalculate 1 CompleteCalcHead;
neuper@37906
   405
neuper@37906
   406
autoCalculate 1 (Step 1); val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
neuper@37906
   407
if is_curr_endof_calc pt ([1],Frm) then ()
neuper@37906
   408
else raise error "rewtools.sml is_curr_endof_calc ([1],Frm)";
neuper@37906
   409
neuper@37906
   410
autoCalculate 1 (Step 1); val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
neuper@37906
   411
if not (is_curr_endof_calc pt ([1],Frm)) then ()
neuper@37906
   412
else raise error "rewtools.sml is_curr_endof_calc ([1],Frm) not";
neuper@37906
   413
if is_curr_endof_calc pt ([1],Res) then ()
neuper@37906
   414
else raise error "rewtools.sml is_curr_endof_calc ([1],Res)";
neuper@37906
   415
neuper@37906
   416
initContext 1 Thy_ ([1],Res);
neuper@37906
   417
neuper@37906
   418
"----- checkContext -----";
neuper@37906
   419
states:=[];
neuper@37906
   420
CalcTree 
neuper@37906
   421
    [(["equality (1+-1*2+x=0)", "solveFor x", "solutions L"],
neuper@37906
   422
      ("Test.thy",
neuper@37906
   423
       ["linear","univariate","equation","test"],
neuper@37906
   424
       ["Test","solve_linear"]))];
neuper@37906
   425
Iterator 1; moveActiveRoot 1;
neuper@37906
   426
autoCalculate 1 CompleteCalc;
neuper@37906
   427
interSteps 1 ([1],Res);
neuper@37906
   428
val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
neuper@37906
   429
neuper@37906
   430
checkContext 1 ([1],Res) "thy_isac_Test-rls-Test_simplify";
neuper@37906
   431
neuper@37906
   432
interSteps 1 ([2],Res);
neuper@37906
   433
val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
neuper@37906
   434
neuper@37906
   435
checkContext 1 ([2,1],Res) "thy_isac_Test-rls-Test_simplify";
neuper@37906
   436
checkContext 1 ([2,2],Res) "thy_isac_Test-rls-Test_simplify";
neuper@37906
   437
neuper@37906
   438
neuper@37906
   439
"----------- fun string_of_thmI for_[.]_) ------------------------";
neuper@37906
   440
"----------- fun string_of_thmI for_[.]_) ------------------------";
neuper@37906
   441
"----------- fun string_of_thmI for_[.]_) ------------------------";
neuper@37906
   442
"----- these work ?!?";
neuper@37906
   443
val th = sym_thm real_minus_eq_cancel;
neuper@37906
   444
val Th = sym_Thm (Thm ("real_minus_eq_cancel", real_minus_eq_cancel));
neuper@37906
   445
val th'= mk_thm Isac.thy ((de_quote o string_of_thm) real_minus_eq_cancel);
neuper@37906
   446
val th'= mk_thm Biegelinie.thy((de_quote o string_of_thm)real_minus_eq_cancel);
neuper@37906
   447
neuper@37906
   448
"----- DIFFERENCE TO ABOVE ?!?: this is still ok, when called in next_tac...";
neuper@37906
   449
val ((pt,(p,p_)), _) = get_calc 1; show_pt pt;
neuper@37906
   450
val Appl (Rewrite' (_,_,_,_,thm',_,_)) =
neuper@37906
   451
    applicable_in (p,p_) pt (Rewrite ("sym_real_minus_eq_cancel",""));
neuper@37906
   452
"- compose stac as done in | appy (*leaf*) by handle_leaf";
neuper@37906
   453
val (th, sr, E, a, v, t) = 
neuper@37906
   454
    ("Biegelinie.thy", 
neuper@37906
   455
     (#srls o get_met) ["IntegrierenUndKonstanteBestimmen"],
neuper@37906
   456
     [(str2term "q__::bool", str2term "q x = q_0")], 
neuper@37926
   457
     SOME (str2term "q x = q_0"),
neuper@37906
   458
     str2term "q__::bool", 
neuper@37906
   459
     str2term "(Rewrite sym_real_minus_eq_cancel False) (q__::bool)");
neuper@37906
   460
val (a', STac stac) = handle_leaf "next  " th sr E a v t;
neuper@37906
   461
term2str stac;
neuper@37906
   462
"--- but this \"m\" is already corrupted";
neuper@37906
   463
val (m,_) = stac2tac_ EmptyPtree (assoc_thy th) stac;
neuper@37906
   464
"- because in assoc_thm'...";
neuper@37906
   465
val (thy, (thmid, ct')) = (Biegelinie.thy, ("sym_real_minus_eq_cancel",""));
neuper@37906
   466
val "s"::"y"::"m"::"_"::id = explode thmid;
neuper@37969
   467
((num_str o (get_thm thy)) (implode id)) RS sym;
neuper@37906
   468
((get_thm thy) (implode id)) RS sym;
neuper@37906
   469
"... this creates [.]";
neuper@37906
   470
((get_thm thy) (implode id));
neuper@37906
   471
"... while this has _NO_ [.]";
neuper@37906
   472
neuper@37906
   473
"----- thus we repair the [.] in string_of_thmI...";
neuper@37969
   474
val thm = ((num_str o (get_thm thy)) (implode id)) RS sym;
neuper@37906
   475
if string_of_thmI thm = "(?b1 = ?a1) = (- ?b1 = - ?a1)" then ()
neuper@37906
   476
else raise error ("rewtools.sml: string_of_thmI " ^ string_of_thm thm ^
neuper@37906
   477
		  " = " ^ string_of_thmI thm);
neuper@37906
   478
neuper@37906
   479
neuper@37906
   480
"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[.]_)-----";
neuper@37906
   481
"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[.]_)-----";
neuper@37906
   482
"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[.]_)-----";
neuper@37906
   483
states:=[];
neuper@37906
   484
CalcTree [(["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
neuper@37906
   485
	     "RandbedingungenBiegung [y 0 = 0, y L = 0]",
neuper@37906
   486
	     "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
neuper@37906
   487
	     "FunktionsVariable x"],
neuper@37906
   488
	    ("Biegelinie.thy",
neuper@37906
   489
	     ["MomentBestimmte","Biegelinien"],
neuper@37906
   490
	     ["IntegrierenUndKonstanteBestimmen"]))];
neuper@37906
   491
moveActiveRoot 1;
neuper@37906
   492
autoCalculate 1 CompleteCalcHead;
neuper@37906
   493
autoCalculate 1 (Step 1) (*Apply_Method*);
neuper@37906
   494
autoCalculate 1 (Step 1) (*->GENERATED ([1], Frm)*);
neuper@37906
   495
"--- this was corrupted before 'fun string_of_thmI'";
neuper@37906
   496
val ((pt,(p,p_)), _) = get_calc 1; show_pt pt;
neuper@37906
   497
if get_obj g_tac pt p = Rewrite ("sym_real_minus_eq_cancel", 
neuper@37906
   498
				 "(?b1 = ?a1) = (- ?b1 = - ?a1)") then ()
neuper@37906
   499
else raise error "rewtools.sml: string_of_thmI ?!?";
neuper@37906
   500
neuper@37906
   501
getTactic 1 ([1],Frm);
neuper@37906
   502
neuper@37906
   503
"----------- fun filter_appl_rews --------------------------------";
neuper@37906
   504
"----------- fun filter_appl_rews --------------------------------";
neuper@37906
   505
"----------- fun filter_appl_rews --------------------------------";
neuper@37906
   506
val f = str2term "a + z + 2*a + 3*z + 5 + 6";
neuper@37906
   507
val thy = assoc_thy "Isac.thy";
neuper@37906
   508
val subst = [(*TODO.WN071231 test Rewrite_Inst*)];
neuper@37906
   509
val rls = Test_simplify;
neuper@37906
   510
(* val rls = rls_p_33;      filter_appl_rews  ---> length 2
neuper@37906
   511
   val rls = norm_Poly;     filter_appl_rews  ---> length 1
neuper@37906
   512
   *)
neuper@37906
   513
if filter_appl_rews thy subst f rls =
neuper@37906
   514
   [Rewrite ("radd_commute", "?m + ?n = ?n + ?m"),
neuper@37906
   515
    Rewrite ("radd_assoc", "?m + ?n + ?k = ?m + (?n + ?k)"),
neuper@37906
   516
    Calculate "plus"] then () 
neuper@37906
   517
else raise error "rewtools.sml filter_appl_rews a + z + 2*a + 3*z + 5 + 6";
neuper@37906
   518
neuper@37906
   519
neuper@37906
   520
"----------- fun is_contained_in ---------------------------------";
neuper@37906
   521
"----------- fun is_contained_in ---------------------------------";
neuper@37906
   522
"----------- fun is_contained_in ---------------------------------";
neuper@37969
   523
val r1 = Thm ("real_diff_minus",num_str @{thm real_diff_minus});
neuper@37906
   524
if contains_rule r1 Test_simplify then ()
neuper@37906
   525
else raise error "rewtools.sml contains_rule Thm";
neuper@37906
   526
neuper@38014
   527
val r1 = Calc ("Groups.plus_class.plus", eval_binop "#add_");
neuper@37906
   528
if contains_rule r1 Test_simplify then ()
neuper@37906
   529
else raise error "rewtools.sml contains_rule Calc";
neuper@37906
   530
neuper@38014
   531
val r1 = Calc ("Groups.minus_class.minus", eval_binop "#add_");
neuper@37906
   532
if not (contains_rule r1 Test_simplify) then ()
neuper@37906
   533
else raise error "rewtools.sml contains_rule Calc";