test/Tools/isac/Interpret/calchead.sml
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 28 Sep 2010 09:06:56 +0200
branchisac-update-Isa09-2
changeset 38031 460c24a6a6ba
parent 38011 3147f2c1525c
child 38032 121765ba0a34
permissions -rw-r--r--
tuned error and writeln

# raise error --> error
# writeln in atomtyp, atomty, atomt and xmlsrc
neuper@37906
     1
(* tests on calchead.sml
neuper@37906
     2
   author: Walther Neuper
neuper@37906
     3
   051013,
neuper@37906
     4
   (c) due to copyright terms
neuper@37906
     5
neuper@38011
     6
12345678901234567890123456789012345678901234567890123456789012345678901234567890
neuper@38011
     7
        10        20        30        40        50        60        70        80
neuper@37906
     8
*)
neuper@37906
     9
neuper@38010
    10
"--------------------------------------------------------";
neuper@38010
    11
"table of contents --------------------------------------";
neuper@38010
    12
"--------------------------------------------------------";
neuper@38010
    13
"--------- get_interval after replace} other 2 ----------";
neuper@38010
    14
"--------- maximum example with 'specify' ---------------";
neuper@38010
    15
"--------- maximum example with 'specify', fmz <> [] ----";
neuper@38010
    16
"--------- maximum example with 'specify', fmz = [] -----";
neuper@38010
    17
"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
neuper@38010
    18
"--------- regression test fun is_copy_named ------------";
neuper@38011
    19
"--------- regr.test fun cpy_nam ------------------------";
neuper@38010
    20
"--------------------------------------------------------";
neuper@38010
    21
"--------------------------------------------------------";
neuper@38010
    22
"--------------------------------------------------------";
neuper@38009
    23
neuper@38011
    24
(*WN100914======================================================================
neuper@38011
    25
"--------- get_interval after replace} other 2 ----------";
neuper@38011
    26
"--------- get_interval after replace} other 2 ----------";
neuper@38011
    27
"--------- get_interval after replace} other 2 ----------";
neuper@38011
    28
states := [];
neuper@37906
    29
 CalcTree
neuper@37906
    30
 [(["equality (x+1=2)", "solveFor x","solutions L"], 
neuper@37906
    31
   ("Test.thy", 
neuper@37906
    32
    ["sqroot-test","univariate","equation","test"],
neuper@37906
    33
    ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
    34
 Iterator 1;
neuper@37906
    35
 moveActiveRoot 1;
neuper@37906
    36
 autoCalculate 1 CompleteCalc;
neuper@37906
    37
 moveActiveFormula 1 ([2],Res); (*there is "-1 + x = 0"*)
neuper@37906
    38
 replaceFormula 1 "x = 1"; 
neuper@37906
    39
 (*... returns calcChangedEvent with ...*)
neuper@37906
    40
 val (unc, del, gen) = (([1],Res), ([4],Res), ([3,2],Res));
neuper@37906
    41
 val ((pt,_),_) = get_calc 1;
neuper@37906
    42
neuper@37906
    43
print_depth 99;map fst (get_interval ([],Pbl) ([],Res) 9999 pt);print_depth 3;
neuper@37906
    44
if map fst (get_interval ([],Pbl) ([],Res) 9999 pt) = 
neuper@37906
    45
    [([], Pbl), ([1], Frm),([1], Res), ([2], Res), ([3], Pbl), ([3, 1], Frm), 
neuper@37906
    46
     ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
neuper@37906
    47
      ([3, 2], Res)] then () else
neuper@38031
    48
error "calchead.sml: diff.behav. get_interval after replace} other 2 a";
neuper@37906
    49
neuper@37906
    50
print_depth 99;map fst (get_interval ([3, 2, 1], Res) ([],Res) 9999 pt);
neuper@37906
    51
print_depth 3;
neuper@37906
    52
if map fst (get_interval ([3, 2, 1], Res) ([],Res) 9999 pt) = 
neuper@37906
    53
    [([3, 2, 1], Res), ([3, 2, 2], Res), ([3, 2], Res)] then () else
neuper@38031
    54
error "modspec.sml: diff.behav. get_interval after replace} other 2 b";
neuper@37906
    55
neuper@37906
    56
neuper@37906
    57
neuper@37906
    58
neuper@37906
    59
"--------- maximum example with 'specify' ------------------------";
neuper@37906
    60
"--------- maximum example with 'specify' ------------------------";
neuper@37906
    61
"--------- maximum example with 'specify' ------------------------";
neuper@37906
    62
(*"              Specify_Problem (match_itms_oris)       ";*)
neuper@37906
    63
val fmz =
neuper@37906
    64
    ["fixedValues [r=Arbfix]","maximum A",
neuper@37906
    65
     "valuesFor [a,b]",
neuper@37906
    66
     "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
neuper@37906
    67
     "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
neuper@37906
    68
     "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
neuper@37906
    69
neuper@37906
    70
     "boundVariable a","boundVariable b","boundVariable alpha",
neuper@37906
    71
     "interval {x::real. 0 <= x & x <= 2*r}",
neuper@37906
    72
     "interval {x::real. 0 <= x & x <= 2*r}",
neuper@37906
    73
     "interval {x::real. 0 <= x & x <= pi}",
neuper@37906
    74
     "errorBound (eps=(0::real))"];
neuper@37906
    75
val (dI',pI',mI') =
neuper@37906
    76
  ("DiffApp.thy",["maximum_of","function"],
neuper@37906
    77
   ["DiffApp","max_by_calculus"]);
neuper@37906
    78
val c = []:cid;
neuper@37906
    79
neuper@37906
    80
(*val nxt = Init_Proof' (fmz,(dI',pI',mI'));
neuper@37906
    81
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt e_pos' [] EmptyPtree;
neuper@37906
    82
*)
neuper@37906
    83
val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
    84
val nxt = tac2tac_ pt p nxt; 
neuper@37906
    85
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
    86
(*val nxt = Add_Given "fixedValues [(r::real) = Arbfix]" : tac*)
neuper@37906
    87
neuper@37906
    88
val nxt = tac2tac_ pt p nxt; 
neuper@37906
    89
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
    90
(**)
neuper@37906
    91
neuper@37906
    92
(*---6.5.03
neuper@37906
    93
val nxt = tac2tac_ pt p (Add_Find "valuesFor [(a::real)]"); 
neuper@37906
    94
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
    95
(*uncaught exception TYPE 6.5.03*)
neuper@37906
    96
neuper@37906
    97
if ppc<>(Problem [],  
neuper@37906
    98
         {Find=[Incompl "maximum",Incompl "valuesFor [a]"],
neuper@37906
    99
	  Given=[Correct "fixedValues [r = Arbfix]"],
neuper@37906
   100
	  Relate=[Incompl "relations []"], Where=[],With=[]})
neuper@38031
   101
then error "test-maximum.sml: model stepwise - different behaviour" 
neuper@37906
   102
else (); (*different with show_types !!!*)
neuper@37906
   103
6.5.03---*)
neuper@37906
   104
neuper@37906
   105
(*-----appl_add should not create Error', but accept as Sup,Syn
neuper@37906
   106
val nxt = tac2tac_ pt p (Add_Given "boundVariable a"); 
neuper@37906
   107
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   108
(**)
neuper@37906
   109
val nxt = tac2tac_ pt p (Add_Given "boundVariable a+"); 
neuper@37906
   110
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   111
(**)---*)
neuper@37906
   112
neuper@37906
   113
val m = Specify_Problem ["maximum_of","function"];
neuper@37906
   114
val nxt = tac2tac_ pt p m; 
neuper@37906
   115
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   116
(**)
neuper@37906
   117
neuper@37906
   118
if ppc<>(Problem ["maximum_of","function"],  
neuper@37906
   119
         {Find=[Incompl "maximum",Incompl "valuesFor"],
neuper@37906
   120
	  Given=[Correct "fixedValues [r = Arbfix]"],
neuper@37906
   121
	  Relate=[Incompl "relations []"], Where=[],With=[]})
neuper@38031
   122
then error "diffappl.sml: Specify_Problem different behaviour" 
neuper@37906
   123
else ();
neuper@37906
   124
(* WN.3.9.03 (#391) Model_Specify did init_pbl newly 
neuper@37906
   125
if ppc<>(Problem ["maximum_of","function"],
neuper@37906
   126
   {Find=[Missing "maximum m_",Missing "valuesFor vs_"],
neuper@37906
   127
    Given=[Correct "fixedValues [r = Arbfix]"],
neuper@37906
   128
    Relate=[Missing "relations rs_"],Where=[],With=[]})
neuper@38031
   129
then error "diffappl.sml: Specify_Problem different behaviour" 
neuper@37906
   130
else ();*)
neuper@37906
   131
neuper@37906
   132
val nxt = tac2tac_ pt p(Specify_Method ["DiffApp","max_by_calculus"]);
neuper@37906
   133
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   134
(**)
neuper@37906
   135
neuper@37906
   136
if ppc<>(Method ["DiffApp","max_by_calculus"],
neuper@37906
   137
	 {Find=[Incompl "maximum",Incompl "valuesFor"],
neuper@37981
   138
	  Given=[Correct "fixedValues [r = Arbfix]",Missing "boundVariable v_v",
neuper@37906
   139
		 Missing "interval itv_",Missing "errorBound err_"],
neuper@37906
   140
	  Relate=[Incompl "relations []"],Where=[],With=[]})
neuper@38031
   141
then error "diffappl.sml: Specify_Method different behaviour" 
neuper@37906
   142
else ();
neuper@37906
   143
(* WN.3.9.03 (#391) Model_Specify did init_pbl newly 
neuper@37906
   144
if ppc<>(Method ["DiffApp","max_by_calculus"],
neuper@37906
   145
   {Find=[Missing "maximum m_",Missing "valuesFor vs_"],
neuper@37981
   146
    Given=[Correct "fixedValues [r = Arbfix]",Missing "boundVariable v_v",
neuper@37906
   147
           Missing "interval itv_",Missing "errorBound err_"],
neuper@37906
   148
    Relate=[Missing "relations rs_"],Where=[],With=[]})
neuper@38031
   149
then error "diffappl.sml: Specify_Method different behaviour" 
neuper@37906
   150
else ();*)
neuper@37906
   151
neuper@37906
   152
neuper@37906
   153
neuper@37906
   154
"--------- maximum example with 'specify', fmz <> [] -------------";
neuper@37906
   155
"--------- maximum example with 'specify', fmz <> [] -------------";
neuper@37906
   156
"--------- maximum example with 'specify', fmz <> [] -------------";
neuper@37906
   157
val fmz =
neuper@37906
   158
    ["fixedValues [r=Arbfix]","maximum A",
neuper@37906
   159
     "valuesFor [a,b]",
neuper@37906
   160
     "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
neuper@37906
   161
     "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
neuper@37906
   162
     "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
neuper@37906
   163
neuper@37906
   164
     "boundVariable a","boundVariable b","boundVariable alpha",
neuper@37906
   165
     "interval {x::real. 0 <= x & x <= 2*r}",
neuper@37906
   166
     "interval {x::real. 0 <= x & x <= 2*r}",
neuper@37906
   167
     "interval {x::real. 0 <= x & x <= pi}",
neuper@37906
   168
     "errorBound (eps=(0::real))"];
neuper@37906
   169
val (dI',pI',mI') =
neuper@37906
   170
  ("DiffApp.thy",["maximum_of","function"],
neuper@37906
   171
   ["DiffApp","max_by_calculus"]);
neuper@37906
   172
val c = []:cid;
neuper@37906
   173
(*val nxt = Init_Proof' (fmz,(dI',pI',mI'));*)
neuper@37906
   174
val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
   175
neuper@37906
   176
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   177
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt e_pos' [] pt;
neuper@37906
   178
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   179
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   180
(*val nxt = Add_Given "fixedValues [(r::real) = Arbfix]" : tac*)
neuper@37906
   181
neuper@37906
   182
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   183
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   184
(*val nxt = Add_Find "maximum (A::bool)" : tac*)
neuper@37906
   185
neuper@37906
   186
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   187
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   188
(*val nxt = Add_Find "valuesFor [(a::real)]" : tac*)
neuper@37906
   189
neuper@37906
   190
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   191
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   192
(*val nxt = Add_Find "valuesFor [(b::real)]" : tac*)
neuper@37906
   193
neuper@37906
   194
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   195
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   196
(*val nxt = Add_Relation "relations [A = a * b]" *)
neuper@37906
   197
neuper@37906
   198
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   199
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   200
(*Add_Relation "relations\n [((a::real) // (#2::real)) ..."*)
neuper@37906
   201
neuper@37906
   202
(*---------------------------- FIXXXXME.meNEW !!! partial Add-Relation !!!
neuper@37906
   203
  nxt_specif <> specify ?!
neuper@37906
   204
neuper@37906
   205
if nxt<>(Add_Relation 
neuper@37906
   206
 "relations [(a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]")
neuper@38031
   207
then error "test specify, fmz <> []: nxt <> Add_Relation (a/2)^2.." else (); (*different with show_types !!!*)
neuper@37906
   208
neuper@37906
   209
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   210
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   211
------------------------------ FIXXXXME.meNEW !!! ---*)
neuper@37906
   212
neuper@37906
   213
(*val nxt = Specify_Theory "DiffApp.thy" : tac*)
neuper@37906
   214
neuper@37924
   215
val itms = get_obj g_pbl pt (fst p);writeln(itms2str_ ctxt itms);
neuper@37906
   216
neuper@37906
   217
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   218
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   219
(*val nxt = Specify_Problem ["maximum_of","function"]*)
neuper@37906
   220
neuper@37906
   221
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   222
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   223
(*val nxt = Specify_Method ("DiffApp.thy","max_by_calculus")*)
neuper@37906
   224
neuper@37906
   225
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   226
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   227
(*val nxt = Add_Given "boundVariable a" : tac*)
neuper@37906
   228
neuper@37906
   229
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   230
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   231
(*val nxt = Add_Given "interval {x. #0 <= x & x <= #2 * r}" : *)
neuper@37906
   232
neuper@37906
   233
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   234
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   235
(*val nxt = Add_Given "errorBound (eps = #0)" : tac*)
neuper@37906
   236
neuper@37906
   237
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   238
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   239
(*val nxt = Apply_Method ("DiffApp.thy","max_by_calculus") *)
neuper@37906
   240
if nxt<>(Apply_Method ["DiffApp","max_by_calculus"])
neuper@38031
   241
then error "test specify, fmz <> []: nxt <> Apply_Method max_by_calculus" else ();
neuper@37906
   242
neuper@37906
   243
neuper@37906
   244
"--------- maximum example with 'specify', fmz = [] --------------";
neuper@37906
   245
"--------- maximum example with 'specify', fmz = [] --------------";
neuper@37906
   246
"--------- maximum example with 'specify', fmz = [] --------------";
neuper@37906
   247
val fmz = [];
neuper@37906
   248
val (dI',pI',mI') = empty_spec;
neuper@37906
   249
val c = []:cid;
neuper@37906
   250
neuper@37906
   251
val nxt = Init_Proof' (fmz,(dI',pI',mI'));(*!!!!!!!!*)
neuper@37906
   252
(*val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))]; !!!*)
neuper@37906
   253
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt e_pos' [] 
neuper@37906
   254
  EmptyPtree;
neuper@37906
   255
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   256
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   257
(*val nxt = Specify_Theory "e_domID" : tac*)
neuper@37906
   258
neuper@37906
   259
val nxt = Specify_Theory "DiffApp.thy";
neuper@37906
   260
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   261
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   262
(*val nxt = Specify_Problem ["e_pblID"] : tac*)
neuper@37906
   263
neuper@37906
   264
val nxt = Specify_Problem ["maximum_of","function"];
neuper@37906
   265
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   266
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   267
(*val nxt = Add_Given "fixedValues" : tac*)
neuper@37906
   268
neuper@37906
   269
val nxt = Add_Given "fixedValues [r=Arbfix]";
neuper@37906
   270
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   271
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   272
(*val nxt = Add_Find "maximum" : tac*)
neuper@37906
   273
neuper@37906
   274
val nxt = Add_Find "maximum A";
neuper@37906
   275
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   276
neuper@37906
   277
neuper@37906
   278
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   279
(*val nxt = Add_Find "valuesFor" : tac*)
neuper@37906
   280
neuper@37906
   281
val nxt = Add_Find "valuesFor [a]";
neuper@37906
   282
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   283
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   284
(*val nxt = Add_Relation "relations" --- 
neuper@37906
   285
  --- [b=Arbfix] KANN NICHT VERLANGT WERDEN !!!!*)
neuper@37906
   286
neuper@37906
   287
(*30.8.01 ... funktioniert nicht mehr nach Einfuehrung env ....
neuper@37906
   288
if nxt<>(Add_Relation "relations []")
neuper@38031
   289
then error "test specify, fmz <> []: nxt <> Add_Relation.." 
neuper@37906
   290
else (); (*different with show_types !!!*)
neuper@37906
   291
*)
neuper@37906
   292
neuper@37906
   293
val nxt = Add_Relation "relations [(A=a+b)]";
neuper@37906
   294
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   295
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   296
(*val nxt = Specify_Method ("e_domID","e_metID") : tac*)
neuper@37906
   297
neuper@37906
   298
val nxt = Specify_Method ["DiffApp","max_by_calculus"];
neuper@37906
   299
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   300
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   301
(*val nxt = Add_Given "boundVariable" : tac*)
neuper@37906
   302
neuper@37906
   303
val nxt = Add_Given "boundVariable alpha";
neuper@37906
   304
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   305
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   306
(*val nxt = Add_Given "interval" : tac*)
neuper@37906
   307
neuper@37906
   308
val nxt = Add_Given "interval {x. 2 <= x & x <= 3}";
neuper@37906
   309
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   310
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   311
(*val nxt = Add_Given "errorBound" : tac*)
neuper@37906
   312
neuper@37906
   313
val nxt = Add_Given "errorBound (eps=999)";
neuper@37906
   314
val nxt = tac2tac_ pt p nxt; 
neuper@37906
   315
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
neuper@37906
   316
(*val nxt = Apply_Method ("DiffApp","max_by_calculus") *)
neuper@37906
   317
(*30.8.01 ... funktioniert nicht mehr nach Einfuehrung env ....
neuper@37906
   318
if nxt<>(Apply_Method ("DiffApp.thy","max_by_calculus"))
neuper@38031
   319
then error "test specify, fmz <> []: nxt <> Add_Relation.." 
neuper@37906
   320
else ();
neuper@37906
   321
*)
neuper@37906
   322
neuper@37906
   323
(* 2.4.00 nach Transfer specify -> hard_gen
neuper@37906
   324
val nxt = Apply_Method ("DiffApp.thy","max_by_calculus");
neuper@37906
   325
val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt; *)
neuper@37906
   326
(*val nxt = Empty_Tac : tac*)
neuper@37906
   327
neuper@38011
   328
====================================================================WN100914*)
neuper@37906
   329
neuper@38011
   330
"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
neuper@38011
   331
"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
neuper@38011
   332
"--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
neuper@37906
   333
val Const ("Script.SubProblem",_) $
neuper@37906
   334
	  (Const ("Pair",_) $
neuper@37906
   335
		 Free (dI',_) $ 
neuper@37906
   336
		 (Const ("Pair",_) $ pI' $ mI')) $ ags' =
neuper@37906
   337
    (*...copied from stac2tac_*)
neuper@38011
   338
    str2term (
neuper@38011
   339
	"SubProblem (EqSystem', [linear, system], [no_met])         " ^
neuper@38011
   340
        "     [BOOL_LIST [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]," ^
neuper@38011
   341
        "      REAL_LIST [c, c_2]]");
neuper@37906
   342
val ags = isalist2list ags';
neuper@37906
   343
val pI = ["linear","system"];
neuper@37906
   344
val pats = (#ppc o get_pbt) pI;
neuper@38011
   345
"-a1-----------------------------------------------------";
neuper@38011
   346
(*match_ags = fn : theory -> pat list -> term list -> ori list*)
neuper@38011
   347
val xxx = match_ags (theory "EqSystem") pats ags;
neuper@38011
   348
"-a2-----------------------------------------------------";
neuper@38011
   349
case match_ags (theory "Isac") pats ags of 
neuper@37906
   350
    [(1, [1], "#Given", Const ("Descript.equalities", _), _),
neuper@37906
   351
     (2, [1], "#Given", Const ("EqSystem.solveForVars", _),
neuper@37906
   352
      [ _ $ Free ("c", _) $ _, _ $ Free ("c_2", _) $ _]),
neuper@38011
   353
     (3, [1], "#Find", Const ("EqSystem.solution", _), [Free ("ss'''", _)])] 
neuper@37906
   354
    =>()
neuper@38031
   355
  | _ => error "calchead.sml match_ags 2 args Nok ----------------";
neuper@37906
   356
neuper@37906
   357
neuper@38011
   358
"-b------------------------------------------------------";
neuper@37906
   359
val Const ("Script.SubProblem",_) $
neuper@37906
   360
	  (Const ("Pair",_) $
neuper@37906
   361
		 Free (dI',_) $ 
neuper@37906
   362
		 (Const ("Pair",_) $ pI' $ mI')) $ ags' =
neuper@37906
   363
    (*...copied from stac2tac_*)
neuper@38011
   364
    str2term (
neuper@38011
   365
	"SubProblem (EqSystem', [linear, system], [no_met])         " ^
neuper@38011
   366
        "     [BOOL_LIST [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]," ^
neuper@38011
   367
        "      REAL_LIST [c, c_2], BOOL_LIST ss''']");
neuper@37906
   368
val ags = isalist2list ags';
neuper@37906
   369
val pI = ["linear","system"];
neuper@37906
   370
val pats = (#ppc o get_pbt) pI;
neuper@38011
   371
"-b1-----------------------------------------------------";
neuper@38011
   372
val xxx = match_ags (theory "Isac") pats ags;
neuper@38011
   373
"-b2-----------------------------------------------------";
neuper@38011
   374
case match_ags (theory "EqSystem") pats ags of 
neuper@37906
   375
    [(1, [1], "#Given", Const ("Descript.equalities", _), _),
neuper@37906
   376
     (2, [1], "#Given", Const ("EqSystem.solveForVars", _),
neuper@37906
   377
         [_ $ Free ("c", _) $ _,
neuper@37906
   378
          _ $ Free ("c_2", _) $ _]),
neuper@38011
   379
     (3, [1], "#Find", Const ("EqSystem.solution", _), [Free ("ss'''", _)])]
neuper@38011
   380
    (*         type of Find:            [Free ("ss'''", "bool List.list")]*)
neuper@37906
   381
    =>()
neuper@38031
   382
  | _ => error "calchead.sml match_ags copy-named dropped --------";
neuper@37906
   383
neuper@37906
   384
neuper@38011
   385
"-c---ERROR case: stac is missing #Given equalities e_s--";
neuper@37906
   386
val stac as Const ("Script.SubProblem",_) $
neuper@37906
   387
	 (Const ("Pair",_) $
neuper@37906
   388
		Free (dI',_) $ 
neuper@37906
   389
		(Const ("Pair",_) $ pI' $ mI')) $ ags' =
neuper@37906
   390
    (*...copied from stac2tac_*)
neuper@38011
   391
    str2term (
neuper@38011
   392
	"SubProblem (EqSystem', [linear, system], [no_met]) " ^
neuper@38011
   393
        "     [REAL_LIST [c, c_2]]");
neuper@38011
   394
val ags = isalist2list ags'; 
neuper@37906
   395
val pI = ["linear","system"];
neuper@37906
   396
val pats = (#ppc o get_pbt) pI;
neuper@38011
   397
(*===inhibit exn provided by this testcase==========================
neuper@38011
   398
val xxx = match_ags (theory "EqSystem") pats ags;
neuper@38011
   399
===================================================================*)
neuper@38011
   400
"-c1-----------------------------------------------------";
neuper@38011
   401
"--------------------------step through code match_ags---";
neuper@38011
   402
val (thy, pbt:pat list, ags) = (theory "EqSystem", pats, ags);
neuper@38011
   403
fun flattup (i,(var,bool,str,itm_)) = (i,var,bool,str,itm_);
neuper@38011
   404
	val pbt' = filter_out is_copy_named pbt; (*=equalities, solveForVars*)
neuper@38011
   405
	val cy = filter is_copy_named pbt;       (*=solution*)
neuper@38011
   406
(*===inhibit exn provided by this testcase==========================
neuper@38011
   407
	val oris' = matc thy pbt' ags [];
neuper@38011
   408
===================================================================*)
neuper@38011
   409
"-------------------------------step through code matc---";
neuper@38011
   410
val (thy, (p as (s,(d,t)))::pbt, a::ags, oris) = (thy, pbt', ags, []);
neuper@38011
   411
(is_copy_named_idstr o free2str) t;
neuper@38011
   412
"---if False:...";
neuper@38011
   413
(*===inhibit exn provided by this testcase==========================
neuper@38011
   414
val opt = mtc thy p a;
neuper@38011
   415
===================================================================*)
neuper@38011
   416
"--------------------------------step through code mtc---";
neuper@38011
   417
val (thy, (str, (dsc, _)):pat, ty $ var) = (thy, p, a);
neuper@38011
   418
cterm_of;
neuper@38011
   419
val ttt = (dsc $ var);
neuper@38011
   420
(*===inhibit exn provided by this testcase==========================
neuper@38011
   421
cterm_of thy (dsc $ var);
neuper@38011
   422
===================================================================*)
neuper@38011
   423
"-------------------------------------step through end---";
neuper@38011
   424
neuper@38011
   425
case ((match_ags (theory "EqSystem") pats ags)
neuper@38011
   426
      handle ERROR _ => []) of (*why not TYPE ?WN100920*)
neuper@37906
   427
    [] => match_ags_msg pI stac ags
neuper@38031
   428
  | _ => error "calchead.sml match_ags 1st arg missing --------";
neuper@37906
   429
neuper@37906
   430
neuper@38011
   431
"-d------------------------------------------------------";
neuper@37906
   432
val stac as Const ("Script.SubProblem",_) $
neuper@37906
   433
	 (Const ("Pair",_) $
neuper@37906
   434
		Free (dI',_) $ 
neuper@37906
   435
		(Const ("Pair",_) $ pI' $ mI')) $ ags' =
neuper@37906
   436
    (*...copied from stac2tac_*)
neuper@38011
   437
    str2term (
neuper@38011
   438
	"SubProblem (Test',[univariate,equation,test]," ^
neuper@38011
   439
        "             [no_met]) [BOOL (x+1=2), REAL x]");
neuper@38011
   440
val AGS = isalist2list ags';
neuper@37906
   441
val pI = ["univariate","equation","test"];
neuper@38011
   442
val PATS = (#ppc o get_pbt) pI;
neuper@38011
   443
"-d1-----------------------------------------------------";
neuper@38011
   444
"--------------------------step through code match_ags---";
neuper@38011
   445
val (thy, pbt:pat list, ags) = (theory "Test", PATS, AGS);
neuper@38011
   446
fun flattup (i,(var,bool,str,itm_)) = (i,var,bool,str,itm_);
neuper@38011
   447
	val pbt' = filter_out is_copy_named pbt; 
neuper@38011
   448
	val cy = filter is_copy_named pbt;       
neuper@38011
   449
	val oris' = matc thy pbt' ags [];
neuper@38011
   450
"-------------------------------step through code matc---";
neuper@38011
   451
val (thy, (p as (s,(d,t)))::pbt, a::ags, oris) = (thy, pbt', ags, []);
neuper@38011
   452
(is_copy_named_idstr o free2str) t;
neuper@38011
   453
"---if False:...";
neuper@38011
   454
val opt = mtc thy p a;
neuper@38011
   455
"--------------------------------step through code mtc---";
neuper@38011
   456
val (thy, (str, (dsc, _)):pat, ty $ var) = (thy, p, a);
neuper@38011
   457
val ttt = (dsc $ var);
neuper@38011
   458
cterm_of thy (dsc $ var);
neuper@38011
   459
val ori = ((([1], str, dsc, (*[var]*) split_dts' (dsc, var))): preori);
neuper@38011
   460
neuper@38011
   461
"-d2-----------------------------------------------------";
neuper@38011
   462
pbt = [];  (*false*)
neuper@38011
   463
"-------------------------------step through code matc---";
neuper@38011
   464
val (thy, (p as (s,(d,t)))::pbt, a::ags, oris) = (thy, pbt, ags, oris @ [ori]);
neuper@38011
   465
(is_copy_named_idstr o free2str) t;
neuper@38011
   466
"---if False:...";
neuper@38011
   467
val opt = mtc thy p a;
neuper@38011
   468
"--------------------------------step through code mtc---";
neuper@38011
   469
val (thy, (str, (dsc, _)):pat, ty $ var) = (thy, p, a);
neuper@38011
   470
val ttt = (dsc $ var);
neuper@38011
   471
cterm_of thy (dsc $ var);
neuper@38011
   472
val ori = ((([1], str, dsc, (*[var]*) split_dts' (dsc, var))): preori);
neuper@38011
   473
"-d3-----------------------------------------------------";
neuper@38011
   474
pbt = [];  (*true, base case*)
neuper@38011
   475
"-----------------continue step through code match_ags---";
neuper@38011
   476
	val oris' = oris @ [ori]; (*result 2 oris, cpy_nam added later*)
neuper@38011
   477
"--------------------------------step through cpy_nam----";
neuper@38011
   478
val (pbt, oris, p as (field, (dsc, t)):pat) = (pbt', oris', hd cy);
neuper@38011
   479
(*t = "v_v'i'" : term             OLD: t = "v_i_"*)
neuper@38011
   480
"--------------------------------------------------------";
neuper@38011
   481
fun is_copy_named_generating_idstr str =
neuper@38011
   482
    if is_copy_named_idstr str
neuper@38011
   483
    then case (rev o explode) str of
neuper@38011
   484
      (*"_"::"_"::"_"::_ => false*)
neuper@38011
   485
	"'"::"'"::"'"::_ => false
neuper@38011
   486
      | _ => true
neuper@38011
   487
    else false;
neuper@38011
   488
fun is_copy_named_generating (_, (_, t)) = 
neuper@38011
   489
    (is_copy_named_generating_idstr o free2str) t;
neuper@38011
   490
"--------------------------------------------------------";
neuper@38011
   491
is_copy_named_generating p (*true*);
neuper@38011
   492
           fun sel (_,_,d,ts) = comp_ts (d, ts);
neuper@38011
   493
	   val cy' = (implode o (drop_last_n 3) o explode o free2str) t;
neuper@38011
   494
               (*"v_v"             OLD: "v_"*)
neuper@38011
   495
	   val ext = (last_elem o drop_last o explode o free2str) t;
neuper@38011
   496
               (*"i"               OLD: "i"*)
neuper@38011
   497
	   val vars' = map (free2str o snd o snd) pbt(*cpy-nam filtered_out*);
neuper@38011
   498
               (*["e_e", "v_v"]    OLD: ["e_", "v_"]*)
neuper@38011
   499
	   val vals = map sel oris;
neuper@38011
   500
               (*[x+1=2, x]        OLD: [x+1=2, x] : term list*)
neuper@38011
   501
vars' ~~ vals;
neuper@38011
   502
(*[("e_e", [x+1=2), ("v_v", x)]    OLD: [("e_", [x+1=2), ("v_", x)]*)
neuper@38011
   503
(assoc (vars'~~vals, cy'));
neuper@38011
   504
(*Some (Free ("x", "RealDef.real")) : term option*)
neuper@38011
   505
	   val cy_ext = (free2str o the) (assoc (vars'~~vals, cy'))^"_"^ext;
neuper@38011
   506
               (*x_i*)
neuper@38011
   507
"-----------------continue step through code match_ags---";
neuper@38011
   508
	val cy' = map (cpy_nam pbt' oris') cy;
neuper@38011
   509
               (*[([1], "#Find", "solutions, [x_i"] (*as terms*) )]*)
neuper@38011
   510
"-------------------------------------step through end---";
neuper@38011
   511
neuper@38011
   512
case match_ags thy PATS AGS of
neuper@38011
   513
[(1, [1], "#Given", Const ("Descript.equality", _),
neuper@38011
   514
  [Const ("op =", _) $ (Const ("Groups.plus_class.plus", _) $
neuper@38011
   515
		Free ("x", _) $ Free ("1", _)) $ Free ("2", _)]),
neuper@38011
   516
 (2, [1], "#Given", Const ("Descript.solveFor", _), [Free ("x", _)]),
neuper@38011
   517
 (3, [1], "#Find", Const ("Descript.solutions", _), [Free ("x_i", _)])]
neuper@37906
   518
    => ()
neuper@38031
   519
  | _ => error "calchead.sml match_ags [univariate,equation,test]--";
neuper@38009
   520
neuper@38010
   521
neuper@38010
   522
"--------- regression test fun is_copy_named ------------";
neuper@38010
   523
"--------- regression test fun is_copy_named ------------";
neuper@38010
   524
"--------- regression test fun is_copy_named ------------";
neuper@38010
   525
val trm = (1, (2, @{term "v'i'"}));
neuper@38031
   526
if is_copy_named trm then () else error "regr. is_copy_named 1";
neuper@38010
   527
val trm = (1, (2, @{term "e_e"}));
neuper@38031
   528
if is_copy_named trm then error "regr. is_copy_named 2" else ();
neuper@38010
   529
val trm = (1, (2, @{term "L'''"}));
neuper@38031
   530
if is_copy_named trm then () else error "regr. is_copy_named 3";
neuper@38010
   531
neuper@38010
   532
(* out-comment 'structure CalcHead'...
neuper@38010
   533
val trm = (1, (2, @{term "v'i'"}));
neuper@38031
   534
if is_copy_named_generating trm then () else error "regr. is_copy_named";
neuper@38010
   535
val trm = (1, (2, @{term "L'''"}));
neuper@38031
   536
if is_copy_named_generating trm then error "regr. is_copy_named" else ();
neuper@38010
   537
*)
neuper@38011
   538
neuper@38011
   539
"--------- regr.test fun cpy_nam ------------------------";
neuper@38011
   540
"--------- regr.test fun cpy_nam ------------------------";
neuper@38011
   541
"--------- regr.test fun cpy_nam ------------------------";
neuper@38011
   542
(*data from above - match_ags, is_cp, cpy_nam +with EqSystem (!)-:*)
neuper@38011
   543
(*the model-pattern, is_copy_named are filter_out*)
neuper@38011
   544
pbt = [("#Given", (@{term "equality"}, @{term "e_e :: bool"})),
neuper@38011
   545
       ("#Given", (@{term "solveFor"}, @{term "v_v :: real"} ))];
neuper@38011
   546
(*the model specific for an example*)
neuper@38011
   547
oris = [([1], "#Given", @{term "equality"} , [str2term "x+1= 2"]),
neuper@38011
   548
	([1], "#Given", @{term "solveFor"} , [@{term "x :: real"} ])];
neuper@38011
   549
cy = [("#Find", (@{term "solutions"}, @{term "v_v'i' :: bool list"}))];
neuper@38011
   550
(*...all must be true*)
neuper@38011
   551
neuper@38011
   552
case cpy_nam pbt oris (hd cy) of 
neuper@38011
   553
    ([1], "#Find", Const ("Descript.solutions", _), [Free ("x_i", _)]) => ()
neuper@38031
   554
  | _ => error "calchead.sml regr.test cpy_nam-1-";
neuper@38011
   555
neuper@38011
   556
(*new data: cpy_nam without changing the name*)
neuper@38011
   557
@{term "equalities"}; type_of @{term "[x_1+1=2,x_2=0]"};
neuper@38011
   558
@{term "solveForVars"}; type_of @{term "[x_1,x_2]::real list"};
neuper@38011
   559
@{term "solution"}; type_of @{term "ss''' :: bool list"};
neuper@38011
   560
(*the model-pattern for ["linear", "system"], is_copy_named are filter_out*)
neuper@38011
   561
val pbt = [("#Given", (@{term "equalities"}, @{term "e_s :: bool list"})),
neuper@38011
   562
       ("#Given", (@{term "solveForVars v_s"}, @{term "v_s :: bool list"} ))];
neuper@38011
   563
(*the model specific for an example*)
neuper@38011
   564
val oris = [([1], "#Given", @{term "equalities"} ,[str2term "[x_1+1=2,x_2=0]"]),
neuper@38011
   565
    ([1], "#Given", @{term "solveForVars"} , [@{term "[x_1,x_2]::real list"}])];
neuper@38011
   566
val cy = [("#Find", (@{term "solution"}, @{term "ss''' :: bool list"}))
neuper@38011
   567
        (*could be more than 1*)];
neuper@38011
   568
neuper@38011
   569
case cpy_nam pbt oris (hd cy) of
neuper@38011
   570
    ([1], "#Find", Const ("EqSystem.solution", _), [Free ("ss'''", _)]) => ()
neuper@38031
   571
  | _ => error "calchead.sml regr.test cpy_nam-2-";