test/Tools/isac/Interpret/ctree.sml
author Alexander Kargl <akargl@brgkepler.net>
Tue, 26 Jul 2011 15:52:07 +0200
branchdecompose-isar
changeset 42202 3ef5679743fb
parent 42193 06de2f62f744
child 42218 dbdaf1e4e614
permissions -rw-r--r--
intermed: uncommented tests
neuper@37906
     1
(* tests for sml/ME/ctree.sml
neuper@37906
     2
   authors: Walther Neuper 060113
neuper@37906
     3
   (c) due to copyright terms
neuper@37906
     4
neuper@37906
     5
use"../smltest/ME/ctree.sml";
neuper@37906
     6
use"ctree.sml";
neuper@37906
     7
*)
neuper@37906
     8
neuper@37906
     9
"-----------------------------------------------------------------";
neuper@37906
    10
"table of contents -----------------------------------------------";
neuper@37906
    11
"-----------------------------------------------------------------";
neuper@37906
    12
"-----------------------------------------------------------------";
neuper@41990
    13
"-------------- fun get_ctxt -------------------------------------";
neuper@41989
    14
"-------------- fun update_ctxt, fun g_ctxt ----------------------";
neuper@41968
    15
"-------------- check positions in miniscript --------------------";
neuper@37906
    16
"-------------- get_allpos' (from ptree above)--------------------";
neuper@37906
    17
"-------------- cut_level (from ptree above)----------------------";
neuper@37906
    18
"-------------- cut_tree (from ptree above)-----------------------";
neuper@37906
    19
"=====new ptree 1a miniscript with mini-subpbl ===================";
neuper@37906
    20
"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
neuper@37906
    21
"=====new ptree 2 miniscript with mini-subpbl ====================";
neuper@37906
    22
"-------------- cut_tree (intermedi.ptree: 3rd level)-------------";
neuper@37906
    23
"-------------- cappend (from ptree above)------------------------";
neuper@37906
    24
"-------------- cappend minisubpbl -------------------------------";
neuper@37906
    25
"=====new ptree 3 ================================================";
neuper@37906
    26
"-------------- move_dn ------------------------------------------";
neuper@37906
    27
"-------------- move_dn: Frm -> Res ------------------------------";
neuper@37906
    28
"-------------- move_up ------------------------------------------";
neuper@37906
    29
"------ move into detail -----------------------------------------";
neuper@37906
    30
"=====new ptree 3a ===============================================";
neuper@37906
    31
"-------------- move_dn in Incomplete ctree ----------------------";
neuper@37906
    32
"=====new ptree 4: crooked by cut_level_'_ =======================";
neuper@37906
    33
(*############## development stopped 0501 ########################*)
neuper@37906
    34
(******************************************************************)
neuper@37906
    35
(*              val SAVE_get_trace = get_trace;                   *)
neuper@37906
    36
(******************************************************************)
neuper@37906
    37
"-------------- get_interval from ctree: incremental development--";
neuper@37906
    38
(******************************************************************)
neuper@37906
    39
(*              val get_trace = SAVE_get_trace;                   *)
neuper@37906
    40
(******************************************************************)
neuper@37906
    41
(*############## development stopped 0501 ########################*)
neuper@37906
    42
"=====new ptree 4 ratequation ====================================";
neuper@37906
    43
"-------------- pt_extract form, tac, asm<>[] --------------------";
neuper@37906
    44
"=====new ptree 5 minisubpbl =====================================";
neuper@37906
    45
"-------------- pt_extract form, tac, asm ------------------------";
neuper@37906
    46
"=====new ptree 6 minisubpbl intersteps ==========================";
neuper@37906
    47
"-------------- get_allpos' new ----------------------------------";
neuper@37906
    48
"-------------- cut_tree new (from ptree above)-------------------";
neuper@37906
    49
"-----------------------------------------------------------------";
neuper@37906
    50
"-----------------------------------------------------------------";
neuper@37906
    51
"-----------------------------------------------------------------";
neuper@37906
    52
neuper@37906
    53
neuper@41990
    54
"-------------- fun get_ctxt -------------------------------------";
neuper@41990
    55
"-------------- fun get_ctxt -------------------------------------";
neuper@41990
    56
"-------------- fun get_ctxt -------------------------------------";
neuper@41990
    57
val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
neuper@41990
    58
val (dI',pI',mI') =
neuper@41990
    59
  ("Test", ["sqroot-test","univariate","equation","test"],
neuper@41990
    60
   ["Test","squ-equ-test-subpbl1"]);
neuper@41990
    61
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@41990
    62
(get_ctxt pt p)
neuper@41992
    63
  handle _ => error "--- fun get_ctxt not even some ctxt found in PblObj";
neuper@41990
    64
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41990
    65
(get_ctxt pt p)
neuper@41992
    66
  handle _ => error "--- fun get_ctxt not even some ctxt found in PrfObj";
neuper@41990
    67
neuper@41989
    68
"-------------- fun update_ctxt, fun g_ctxt ----------------------";
neuper@41989
    69
"-------------- fun update_ctxt, fun g_ctxt ----------------------";
neuper@41989
    70
"-------------- fun update_ctxt, fun g_ctxt ----------------------";
neuper@41992
    71
val pt = EmptyPtree;
neuper@41992
    72
val pt = append_problem [] (e_istate, e_ctxt) e_fmz ([(*oris*)], e_spec, e_term) pt;
neuper@41992
    73
val ctxt = get_obj g_ctxt pt [];
neuper@41992
    74
if is_e_ctxt ctxt then () else error "--- fun update_ctxt, fun g_ctxt: append_problem changed";
neuper@41989
    75
val pt = update_ctxt pt [] (ProofContext.init_global @{theory "Isac"});
neuper@41992
    76
if (get_obj g_ctxt pt [] |> ProofContext.theory_of |> Context.theory_name) = "Isac"
neuper@41992
    77
then () else error "--- fun update_ctxt, fun g_ctxt changed";
neuper@41989
    78
neuper@41968
    79
"-------------- check positions in miniscript --------------------";
neuper@41968
    80
"-------------- check positions in miniscript --------------------";
neuper@41968
    81
"-------------- check positions in miniscript --------------------";
neuper@41972
    82
val fmz = ["equality (x+1=(2::real))",
bonzai@41950
    83
	   "solveFor x","solutions L"];
neuper@37906
    84
val (dI',pI',mI') =
neuper@38058
    85
  ("Test",["sqroot-test","univariate","equation","test"],
neuper@37906
    86
   ["Test","squ-equ-test-subpbl1"]);
neuper@37906
    87
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
bonzai@41951
    88
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
    89
(* nxt = Add_Given "equality (x + 1 = 2)"
neuper@37924
    90
   (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
neuper@37906
    91
   *)
bonzai@41950
    92
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37924
    93
(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
neuper@37906
    94
   *)
neuper@37906
    95
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37924
    96
(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
neuper@37906
    97
   *)
neuper@37906
    98
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
    99
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   100
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   101
"ctree.sml-------------- get_allpos' new ------------------------\"";
neuper@37906
   102
val (PP, pp) = split_last [1];
neuper@37906
   103
val ((pt', cuts), clevup) = cut_bottom (PP, pp) (get_nd pt PP);
neuper@37906
   104
neuper@37906
   105
val cuts = get_allp [] ([], ([],Frm)) pt;
neuper@37906
   106
val cuts2 = get_allps [] [1] (children pt);
neuper@37906
   107
"ctree.sml-------------- cut_tree new (from ptree above)----------";
neuper@37906
   108
val (pt', cuts) = cut_tree pt ([1],Frm);
neuper@37906
   109
"ctree.sml-------------- cappend on complete ctree from above ----";
bonzai@41949
   110
val (pt', cuts) = cappend_form pt [1] (e_istate, e_ctxt) (str2term "Inform[1]");
neuper@37906
   111
"----------------------------------------------------------------/";
akargl@42108
   112
neuper@37906
   113
val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_form: pos =[1]*);
neuper@37906
   114
val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[1]*);
neuper@37906
   115
val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[2]*);
neuper@37906
   116
val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_problem: pos =[3]*);
neuper@37906
   117
neuper@37906
   118
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   119
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   120
(*val nxt = ("Add_Given", Add_Given "equality (-1 + x = 0)").....*)
neuper@37906
   121
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   122
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   123
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   124
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   125
(*val nxt = ("Apply_Method", Apply_Method ["Test", "solve_linear"])*)
neuper@37906
   126
neuper@37906
   127
val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_form: pos =[3,1]*);
neuper@37906
   128
val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[3,1]*);
neuper@37906
   129
val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[3,2]*);
neuper@37906
   130
val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*.append_result: pos =[3]*);
neuper@37906
   131
val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[4]*);
neuper@37906
   132
val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*.append_result: pos =[]*);
neuper@37906
   133
val Form' (FormKF (~1,EdUndef,0,Nundef,res)) = f;
neuper@37906
   134
if (snd nxt)=End_Proof' andalso res="[x = 1]" then ()
neuper@38031
   135
else error "new behaviour in test: miniscript with mini-subpbl";
neuper@37906
   136
neuper@37906
   137
 show_pt pt;
neuper@37906
   138
neuper@37906
   139
"-------------- get_allpos' (from ptree above)--------------------";
neuper@37906
   140
"-------------- get_allpos' (from ptree above)--------------------";
neuper@37906
   141
"-------------- get_allpos' (from ptree above)--------------------";
neuper@37906
   142
if get_allpos' ([], 1) pt = 
neuper@37906
   143
   [([], Frm), 
neuper@37906
   144
    ([1], Frm), 
neuper@37906
   145
    ([1], Res), 
neuper@37906
   146
    ([2], Res), 
neuper@37906
   147
    ([3], Frm), 
neuper@37906
   148
    ([3, 1], Frm),
neuper@37906
   149
    ([3, 1], Res), 
neuper@37906
   150
    ([3, 2], Res), 
neuper@37906
   151
    ([3], Res), 
neuper@37906
   152
    ([4], Res), 
neuper@37906
   153
    ([], Res)]
neuper@38031
   154
then () else error "ctree.sml: diff:behav. in get_allpos' 1";
neuper@37906
   155
neuper@37906
   156
if get_allpos's ([], 1) (children pt) = 
neuper@37906
   157
   [([1], Frm), 
neuper@37906
   158
    ([1], Res), 
neuper@37906
   159
    ([2], Res), 
neuper@37906
   160
    ([3], Frm), 
neuper@37906
   161
    ([3, 1], Frm),
neuper@37906
   162
    ([3, 1], Res), 
neuper@37906
   163
    ([3, 2], Res), 
neuper@37906
   164
    ([3], Res), 
neuper@37906
   165
    ([4], Res)]
neuper@38031
   166
then () else error "ctree.sml: diff:behav. in get_allpos' 2";
neuper@37906
   167
neuper@37906
   168
if get_allpos's ([], 2) (takerest (1, children pt)) = 
neuper@37906
   169
   [([2], Res), 
neuper@37906
   170
    ([3], Frm), 
neuper@37906
   171
    ([3, 1], Frm), 
neuper@37906
   172
    ([3, 1], Res), 
neuper@37906
   173
    ([3, 2], Res),
neuper@37906
   174
    ([3], Res), 
neuper@37906
   175
    ([4], Res)]
neuper@38031
   176
then () else error "ctree.sml: diff:behav. in get_allpos' 3";
neuper@37906
   177
neuper@37906
   178
if get_allpos's ([], 3) (takerest (2, children pt)) = 
neuper@37906
   179
   [([3], Frm), 
neuper@37906
   180
    ([3, 1], Frm),
neuper@37906
   181
    ([3, 1], Res),
neuper@37906
   182
    ([3, 2], Res),
neuper@37906
   183
    ([3], Res),
neuper@37906
   184
    ([4], Res)]
neuper@38031
   185
then () else error "ctree.sml: diff:behav. in get_allpos' 4";
neuper@37906
   186
neuper@37906
   187
if get_allpos's ([3], 1) (children (nth 3 (children pt))) = 
neuper@37906
   188
   [([3, 1], Frm),
neuper@37906
   189
    ([3, 1], Res),
neuper@37906
   190
    ([3, 2], Res)]
neuper@38031
   191
then () else error "ctree.sml: diff:behav. in get_allpos' 5";
neuper@37906
   192
neuper@37906
   193
if get_allpos' ([3], 1) (nth 3 (children pt)) = 
neuper@37906
   194
   [([3], Frm),
neuper@37906
   195
    ([3, 1], Frm),
neuper@37906
   196
    ([3, 1], Res),
neuper@37906
   197
    ([3, 2], Res),
neuper@37906
   198
    ([3], Res)]
neuper@38031
   199
then () else error "ctree.sml: diff:behav. in get_allpos' 6";
neuper@37906
   200
neuper@37906
   201
akargl@42190
   202
akargl@42190
   203
akargl@42190
   204
akargl@42190
   205
neuper@37906
   206
"-------------- cut_level (from ptree above)----------------------";
neuper@37906
   207
"-------------- cut_level (from ptree above)----------------------";
neuper@37906
   208
"-------------- cut_level (from ptree above)----------------------";
neuper@37906
   209
show_pt pt;
neuper@37906
   210
show_pt pt';
neuper@37906
   211
print_depth 99; cuts; print_depth 3;
neuper@37906
   212
neuper@37906
   213
(*if cuts = [([2], Res),
neuper@37906
   214
	   ([3], Frm),
neuper@37906
   215
	   ([3, 1], Frm),
neuper@37906
   216
	   ([3, 1], Res),
neuper@37906
   217
	   ([3, 2], Res),
neuper@37906
   218
	   ([3], Res),
neuper@37906
   219
	   ([4], Res)]
neuper@38031
   220
then () else error "ctree.sml: diff:behav. in cut_level 1a";
neuper@37906
   221
val (res,asm) = get_obj g_result pt' [2];
neuper@37906
   222
if res = e_term andalso asm = [] then () else
neuper@38031
   223
error "ctree.sml: diff:behav. in cut_level 1aa" WN050219*);
neuper@37906
   224
if not (existpt [2] pt') then () else
neuper@38031
   225
error "ctree.sml: diff:behav. in cut_level 1aa2" (*WN050220*);
neuper@37906
   226
neuper@37906
   227
val (res,asm) = get_obj g_result pt' [];
akargl@42193
   228
akargl@42193
   229
(*============ inhibit exn AK110726 ==============================================
neuper@37906
   230
if term2str res = "[x = 1]" (*WN050219 e_term in cut_tree!!!*) then () else
neuper@38031
   231
error "ctree.sml: diff:behav. in cut_level 1ab";
neuper@37906
   232
if map fst (get_interval ([],Frm) ([],Res) 9999 pt') =
neuper@37906
   233
   [([], Frm), 
neuper@37906
   234
    ([1], Frm), 
neuper@37906
   235
    ([1], Res), 
neuper@37906
   236
    ([2], Res),(*, e_term in cut_tree!!!*)
neuper@37906
   237
    ([], Res)] then () else 
neuper@38031
   238
error "ctree.sml: diff:behav. in cut_level 1b";
akargl@42193
   239
============ inhibit exn AK110726 ==============================================*)
neuper@37906
   240
neuper@37906
   241
val (pt',cuts) = cut_level [] [] pt ([2],Res);
neuper@37906
   242
if cuts = [([3], Frm), 
neuper@37906
   243
	   ([3, 1], Frm), 
neuper@37906
   244
	   ([3, 1], Res), 
neuper@37906
   245
	   ([3, 2], Res), 
neuper@37906
   246
	   ([3], Res), 
neuper@37906
   247
	   ([4], Res)]
neuper@38031
   248
then () else error "ctree.sml: diff:behav. in cut_level 2a";
neuper@37906
   249
neuper@37906
   250
if pr_ptree pr_short pt' = ".    ----- pblobj -----\n1.   x + 1 = 2\n2.   x + 1 + -1 * 2 = 0\n"
neuper@38031
   251
then () else error "ctree.sml: diff:behav. in cut_level 2b";
neuper@37906
   252
neuper@37906
   253
val (pt',cuts) = cut_level [] [3] pt ([3,1],Frm);
neuper@37906
   254
if cuts = [([3, 1], Res), ([3, 2], Res)]
neuper@38031
   255
then () else error "ctree.sml: diff:behav. in cut_level 3a";
neuper@37906
   256
if pr_ptree pr_short pt' = ".    ----- pblobj -----\n1.   x + 1 = 2\n2.   x + 1 + -1 * 2 = 0\n3.    ----- pblobj -----\n3.1.   -1 + x = 0\n4.   [x = 1]\n"
neuper@38031
   257
then () else error "ctree.sml: diff:behav. in cut_level 3b";
neuper@37906
   258
neuper@37906
   259
val (pt',cuts) = cut_level [] [3] pt ([3,1],Res);
neuper@37906
   260
if cuts = [([3, 2], Res)]
neuper@38031
   261
then () else error "ctree.sml: diff:behav. in cut_level 4a";
neuper@37906
   262
if pr_ptree pr_short pt' = ".    ----- pblobj -----\n1.   x + 1 = 2\n2.   x + 1 + -1 * 2 = 0\n3.    ----- pblobj -----\n3.1.   -1 + x = 0\n4.   [x = 1]\n"
neuper@38031
   263
then () else error "ctree.sml: diff:behav. in cut_level 4b";
neuper@37906
   264
neuper@37906
   265
neuper@37906
   266
"-------------- cut_tree (from ptree above)-----------------------";
neuper@37906
   267
"-------------- cut_tree (from ptree above)-----------------------";
neuper@37906
   268
"-------------- cut_tree (from ptree above)-----------------------";
neuper@37906
   269
val (pt', cuts) = cut_tree pt ([2],Frm);(*not created by move_dn -- not on WS*)
akargl@42193
   270
akargl@42193
   271
(*============ inhibit exn AK110726 ==============================================
neuper@37906
   272
if cuts = [([2], Res),
neuper@37906
   273
	   ([3], Frm),
neuper@37906
   274
	   ([3, 1], Frm),
neuper@37906
   275
	   ([3, 1], Res),
neuper@37906
   276
	   ([3, 2], Res),
neuper@37906
   277
	   ([3], Res),
neuper@37906
   278
	   ([4], Res),
neuper@37906
   279
	   ([], Res)]
neuper@38031
   280
then () else error "ctree.sml: diff:behav. in cut_tree 1a";
neuper@37906
   281
neuper@37906
   282
val (res,asm) = get_obj g_result pt' [2];
akargl@42193
   283
============ inhibit exn AK110726 ==============================================*)
akargl@42193
   284
neuper@37906
   285
if res = e_term (*WN050219 done by cut_level*) then () else
neuper@38031
   286
error "ctree.sml: diff:behav. in cut_tree 1aa";
neuper@37906
   287
akargl@42193
   288
(*============ inhibit exn AK110726 ==============================================
neuper@37906
   289
val form = get_obj g_form pt' [2];
neuper@37906
   290
if term2str form = "x + 1 + -1 * 2 = 0" (*remained !!!*) then () else
neuper@38031
   291
error "ctree.sml: diff:behav. in cut_tree 1ab";
akargl@42193
   292
============ inhibit exn AK110726 ==============================================*)
neuper@37906
   293
neuper@37906
   294
val (res,asm) = get_obj g_result pt' [];
neuper@37906
   295
if res = e_term (*WN050219 done by cut_tree*) then () else
neuper@38031
   296
error "ctree.sml: diff:behav. in cut_tree 1ac";
neuper@37906
   297
neuper@37906
   298
if map fst (get_interval ([],Frm) ([],Res) 9999 pt') =
neuper@37906
   299
   [([], Frm), 
neuper@37906
   300
    ([1], Frm), 
neuper@37906
   301
    ([1], Res)] then () else 
neuper@38031
   302
error "ctree.sml: diff:behav. in cut_tree 1ad";
neuper@37906
   303
neuper@37906
   304
val (pt', cuts) = cut_tree pt ([2],Res);
akargl@42193
   305
(*============ inhibit exn AK110726 ==============================================
neuper@37906
   306
if cuts = [([3], Frm),
neuper@37906
   307
	   ([3, 1], Frm),
neuper@37906
   308
	   ([3, 1], Res),
neuper@37906
   309
	   ([3, 2], Res),
neuper@37906
   310
	   ([3], Res),
neuper@37906
   311
	   ([4], Res),
neuper@37906
   312
	   ([], Res)]
neuper@38031
   313
then () else error "ctree.sml: diff:behav. in cut_tree 2";
akargl@42193
   314
============ inhibit exn AK110726 ==============================================*)
neuper@37906
   315
neuper@37906
   316
val (pt', cuts) = cut_tree pt ([3,1],Frm);
akargl@42193
   317
(*============ inhibit exn AK110726 ==============================================
neuper@37906
   318
if cuts = [([3, 1], Res), 
neuper@37906
   319
	   ([3, 2], Res),
neuper@37906
   320
	   ([3], Res),
neuper@37906
   321
	   ([4], Res),
neuper@37906
   322
	   ([], Res)]
neuper@38031
   323
then () else error "ctree.sml: diff:behav. in cut_tree 3";
akargl@42193
   324
============ inhibit exn AK110726 ==============================================*)
neuper@37906
   325
neuper@37906
   326
val (pt', cuts) = cut_tree pt ([3,1],Res);
neuper@37906
   327
if cuts = [([3, 2], Res),
neuper@37906
   328
	   ([3], Res),
neuper@37906
   329
	   ([4], Res),
neuper@37906
   330
	   ([], Res)]
neuper@38031
   331
then () else error "ctree.sml: diff:behav. in cut_tree 4";
neuper@37906
   332
neuper@37906
   333
"=====new ptree 1a miniscript with mini-subpbl ===================";
neuper@37906
   334
"=====new ptree 1a miniscript with mini-subpbl ===================";
neuper@37906
   335
"=====new ptree 1a miniscript with mini-subpbl ===================";
neuper@41970
   336
val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
neuper@37906
   337
val (dI',pI',mI') =
neuper@38058
   338
  ("Test",["sqroot-test","univariate","equation","test"],
neuper@37906
   339
   ["Test","squ-equ-test-subpbl1"]);
neuper@37906
   340
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
   341
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   342
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   343
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   344
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   345
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   346
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   347
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   348
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   349
show_pt pt;
neuper@37906
   350
neuper@37906
   351
"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
neuper@37906
   352
"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
neuper@37906
   353
"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
neuper@37906
   354
neuper@37906
   355
val (pt',cuts) = cut_level [] [3] pt ([1],Frm);(*([1],Frm) is stored*)
neuper@37906
   356
if cuts = [](*([1],Res) is not yet stored (Nd.ostate=Incomplete)*)
neuper@38031
   357
then () else error "ctree.sml: diff:behav. in cut_tree 4a";
neuper@37906
   358
neuper@37906
   359
val (pt', cuts) = cut_tree pt ([1],Frm);
neuper@37906
   360
if cuts = []
neuper@38031
   361
then () else error "ctree.sml: diff:behav. in cut_tree 4a";
neuper@37906
   362
neuper@37906
   363
(*WN050219
neuper@37906
   364
val pos as ([p],_) = ([1],Frm);
neuper@37906
   365
val pt as Nd (b,_) = pt;
neuper@37906
   366
neuper@37906
   367
neuper@37906
   368
show_pt pt;
neuper@37906
   369
show_pt pt';
neuper@37906
   370
print_depth 99;cuts;print_depth 3;
neuper@37906
   371
print_depth 99;map fst (get_interval ([],Frm) ([],Res) 9999 pt');print_depth 3;
akargl@42190
   372
####################################################################*)
akargl@42190
   373
akargl@42190
   374
akargl@42190
   375
akargl@42190
   376
akargl@42190
   377
akargl@42190
   378
akargl@42190
   379
neuper@37906
   380
neuper@37906
   381
"=====new ptree 2 miniscript with mini-subpbl ====================";
neuper@37906
   382
"=====new ptree 2 miniscript with mini-subpbl ====================";
neuper@37906
   383
"=====new ptree 2 miniscript with mini-subpbl ====================";
neuper@37906
   384
 states:=[];
neuper@41970
   385
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   386
   ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   387
    ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   388
 Iterator 1; moveActiveRoot 1;
neuper@37906
   389
 autoCalculate 1 CompleteCalc; 
neuper@37906
   390
neuper@37906
   391
 interSteps 1 ([3,2],Res);
neuper@37906
   392
neuper@37906
   393
 val ((pt,_),_) = get_calc 1;
neuper@37906
   394
 show_pt pt;
neuper@37906
   395
neuper@42185
   396
if (term2str o fst) (get_obj g_result pt [3,2,1]) = "x = 0 + 1" then ()
neuper@42185
   397
else error "mini-subpbl interSteps broken";
neuper@42185
   398
neuper@37906
   399
"-------------- cut_tree (intermedi.ptree: 3rd level)-------------";
neuper@37906
   400
"-------------- cut_tree (intermedi.ptree: 3rd level)-------------";
neuper@37906
   401
"-------------- cut_tree (intermedi.ptree: 3rd level)-------------";
neuper@37906
   402
(*WN050225 intermed. outcommented
neuper@37906
   403
 val (pt', cuts) = cut_tree pt ([3,2,1],Frm);
neuper@37906
   404
 if cuts = [([3, 2, 1], Res),
neuper@37906
   405
	    ([3, 2, 2], Res),
neuper@37906
   406
	    ([3, 2], Res), 
neuper@37906
   407
	    ([3], Res),
neuper@37906
   408
	    ([4], Res)]
neuper@38031
   409
 then () else error "ctree.sml: diff:behav. in cut_tree 3rd level 1";
neuper@37906
   410
neuper@37906
   411
 val (pt', cuts) = cut_tree pt ([3,2,1],Res);
neuper@37906
   412
 if cuts = [([3, 2, 2], Res),
neuper@37906
   413
	    ([3, 2], Res), 
neuper@37906
   414
	    ([3], Res),
neuper@37906
   415
	    ([4], Res)]
neuper@38031
   416
 then () else error "ctree.sml: diff:behav. in cut_tree 3rd level 2";
neuper@37906
   417
neuper@37906
   418
neuper@37906
   419
"-------------- cappend (from ptree above)------------------------";
neuper@37906
   420
"-------------- cappend (from ptree above)------------------------";
neuper@37906
   421
"-------------- cappend (from ptree above)------------------------";
neuper@37906
   422
val (pt',cuts) = cappend_form pt [3,2,1] e_istate (str2term "newnew");
neuper@37906
   423
if cuts = [([3, 2, 1], Res),
neuper@37906
   424
	   ([3, 2, 2], Res),
neuper@37906
   425
	   ([3, 2], Res), 
neuper@37906
   426
	   ([3], Res),
neuper@37906
   427
	   ([4], Res),
neuper@37906
   428
	   ([], Res)]
neuper@38031
   429
then () else error "ctree.sml: diff:behav. in cappend_form";
neuper@37906
   430
if term2str (get_obj g_form pt' [3,2,1]) = "newnew" andalso
neuper@37906
   431
   get_obj g_tac pt' [3,2,1] = Empty_Tac andalso
neuper@37906
   432
   term2str (fst (get_obj g_result pt' [3,2,1])) = "??.empty"
neuper@38031
   433
 then () else error "ctree.sml: diff:behav. in cappend 1";
neuper@37906
   434
neuper@37906
   435
val (pt',cuts) = cappend_atomic pt [3,2,1] e_istate (str2term "newform")
neuper@37906
   436
    (Tac "test") (str2term "newresult",[]) Complete;
neuper@37906
   437
if cuts = [([3, 2, 1], Res), (*?????????????*)
neuper@37906
   438
	   ([3, 2, 2], Res),
neuper@37906
   439
	   ([3, 2], Res),
neuper@37906
   440
	   ([3], Res),
neuper@37906
   441
	   ([4], Res),
neuper@37906
   442
	   ([], Res)]
neuper@38031
   443
then () else error "ctree.sml: diff:behav. in cappend_atomic";
neuper@37906
   444
neuper@37906
   445
neuper@37906
   446
neuper@37906
   447
"-------------- cappend minisubpbl -------------------------------";
neuper@37906
   448
"-------------- cappend minisubpbl -------------------------------";
neuper@37906
   449
"-------------- cappend minisubpbl -------------------------------";
neuper@37906
   450
"=====new ptree 1 miniscript with mini-subpbl ====================";
neuper@41970
   451
val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
neuper@37906
   452
val (dI',pI',mI') =
neuper@38058
   453
  ("Test",["sqroot-test","univariate","equation","test"],
neuper@37906
   454
   ["Test","squ-equ-test-subpbl1"]);
neuper@37906
   455
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
   456
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   457
(* nxt = Add_Given "equality (x + 1 = 2)"
neuper@37924
   458
   (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
neuper@37906
   459
   *)
neuper@37906
   460
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37924
   461
(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
neuper@37906
   462
   *)
neuper@37906
   463
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37924
   464
(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
neuper@37906
   465
   *)
neuper@37906
   466
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   467
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   468
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   469
(*###cappend_form: pos =[1]  ... while calculating nxt, which pt is dropped
neuper@37906
   470
val nxt = ("Apply_Method", Apply_Method ["Test", "squ-equ-test-subpbl1"])*)
neuper@37906
   471
neuper@37906
   472
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[1]*);
neuper@37906
   473
val p = ([1], Frm);
neuper@37906
   474
val (pt,cuts) = cappend_form pt (fst p) e_istate (str2term "x + 1 = 2");
neuper@37906
   475
val form = get_obj g_form pt (fst p);
neuper@37906
   476
val (res,_) = get_obj g_result pt (fst p);
neuper@37906
   477
if term2str form = "x + 1 = 2" andalso res = e_term then () else
neuper@38031
   478
error "ctree.sml, diff.behav. cappend minisubpbl ([1],Frm)";
neuper@37906
   479
if not (existpt ((lev_on o fst) p) pt) then () else
neuper@38031
   480
error "ctree.sml, diff.behav. cappend minisubpbl ([1],Frm) nxt";
neuper@37906
   481
neuper@37906
   482
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[1]*);
neuper@37906
   483
val p = ([1], Res);
neuper@37906
   484
val (pt,cuts) = 
neuper@37906
   485
    cappend_atomic pt (fst p) e_istate (str2term "x + 1 = 2")
neuper@37906
   486
		   Empty_Tac (str2term "x + 1 + -1 * 2 = 0",[]) Incomplete;
neuper@37906
   487
val form = get_obj g_form pt (fst p);
neuper@37906
   488
val (res,_) = get_obj g_result pt (fst p);
neuper@37906
   489
if term2str form = "x + 1 = 2" andalso term2str res = "x + 1 + -1 * 2 = 0" 
neuper@38031
   490
then () else error "ctree.sml, diff.behav. cappend minisubpbl ([1],Res)";
neuper@37906
   491
if not (existpt ((lev_on o fst) p) pt) then () else
neuper@38031
   492
error "ctree.sml, diff.behav. cappend minisubpbl ([1],Res) nxt";
neuper@37906
   493
neuper@37906
   494
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[2]*);
neuper@37906
   495
val p = ([2], Res);
neuper@37906
   496
val (pt,cuts) = 
neuper@37906
   497
    cappend_atomic pt (fst p) e_istate (str2term "x + 1 + -1 * 2 = 0")
neuper@37906
   498
		   Empty_Tac (str2term "-1 + x = 0",[]) Incomplete;
neuper@37906
   499
val form = get_obj g_form pt (fst p);
neuper@37906
   500
val (res,_) = get_obj g_result pt (fst p);
neuper@37906
   501
if term2str form = "x + 1 + -1 * 2 = 0" andalso term2str res = "-1 + x = 0"
neuper@38031
   502
then () else error "ctree.sml, diff.behav. cappend minisubpbl ([2],Res)";
neuper@37906
   503
if not (existpt ((lev_on o fst) p) pt) then () else
neuper@38031
   504
error "ctree.sml, diff.behav. cappend minisubpbl ([2],Res) nxt";
neuper@37906
   505
neuper@37906
   506
neuper@37906
   507
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;(**)cappend_problem: pos =[3]*)
neuper@37906
   508
val p = ([3], Pbl);
neuper@37906
   509
val (pt,cuts) = cappend_problem pt (fst p) e_istate e_fmz ([],e_spec,e_term);
neuper@37906
   510
if is_pblobj (get_obj I pt (fst p)) then () else 
neuper@38031
   511
error "ctree.sml, diff.behav. cappend minisubpbl ([3],Pbl)";
neuper@37906
   512
if not (existpt ((lev_on o fst) p) pt) then () else
neuper@38031
   513
error "ctree.sml, diff.behav. cappend minisubpbl ([3],Pbl) nxt";
neuper@37906
   514
neuper@37906
   515
(* ...complete calchead skipped...*)
neuper@37906
   516
neuper@37906
   517
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[3,1]*);
neuper@37906
   518
val p = ([3, 1], Frm);
neuper@37906
   519
val (pt,cuts) = cappend_form pt (fst p) e_istate (str2term "-1 + x = 0");
neuper@37906
   520
val form = get_obj g_form pt (fst p);
neuper@37906
   521
val (res,_) = get_obj g_result pt (fst p);
neuper@37906
   522
if term2str form = "-1 + x = 0" andalso res = e_term then () else
neuper@38031
   523
error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Frm)";
neuper@37906
   524
if not (existpt ((lev_on o fst) p) pt) then () else
neuper@38031
   525
error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Frm) nxt";
neuper@37906
   526
neuper@37906
   527
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;(**)cappend_atomic: pos =[3,1]*)
neuper@37906
   528
val p = ([3, 1], Res);
neuper@37906
   529
val (pt,cuts) = 
neuper@37906
   530
    cappend_atomic pt (fst p) e_istate (str2term "-1 + x = 0")
neuper@37906
   531
		   Empty_Tac (str2term "x = 0 + -1 * -1",[]) Incomplete;
neuper@37906
   532
val form = get_obj g_form pt (fst p);
neuper@37906
   533
val (res,_) = get_obj g_result pt (fst p);
neuper@37906
   534
if term2str form = "-1 + x = 0" andalso term2str res = "x = 0 + -1 * -1" then()
neuper@38031
   535
else error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Res)";
neuper@37906
   536
if not (existpt ((lev_on o fst) p) pt) then () else
neuper@38031
   537
error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Res) nxt";
neuper@37906
   538
neuper@37906
   539
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[3,1]*);
neuper@37906
   540
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[3,1]*);
neuper@37906
   541
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[3,2]*);
neuper@37906
   542
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**).append_result: pos =[3]*);
neuper@37906
   543
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[4]*);
neuper@37906
   544
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**).append_result: pos =[]*);
neuper@37906
   545
neuper@37906
   546
WN050225 intermed. outcommented---*)
neuper@37906
   547
neuper@37906
   548
"=====new ptree 3 ================================================";
neuper@37906
   549
"=====new ptree 3 ================================================";
neuper@37906
   550
"=====new ptree 3 ================================================";
akargl@42120
   551
akargl@42120
   552
states:=[];
neuper@41970
   553
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   554
   ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   555
    ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   556
 Iterator 1; moveActiveRoot 1;
neuper@37906
   557
 autoCalculate 1 CompleteCalc; 
neuper@37906
   558
neuper@37906
   559
 val ((pt,_),_) = get_calc 1;
neuper@37906
   560
 show_pt pt;
neuper@37906
   561
neuper@37906
   562
"-------------- move_dn ------------------------------------------";
neuper@37906
   563
"-------------- move_dn ------------------------------------------";
neuper@37906
   564
"-------------- move_dn ------------------------------------------";
neuper@37906
   565
 val p = move_dn [] pt ([],Pbl) (*-> ([1],Frm)*);
neuper@37906
   566
 val p = move_dn [] pt p        (*-> ([1],Res)*);
neuper@37906
   567
 val p = move_dn [] pt p        (*-> ([2],Res)*);
neuper@37906
   568
 val p = move_dn [] pt p        (*-> ([3],Pbl)*);
neuper@37906
   569
 val p = move_dn [] pt p        (*-> ([3,1],Frm)*);
neuper@37906
   570
 val p = move_dn [] pt p        (*-> ([3,1],Res)*);
neuper@37906
   571
 val p = move_dn [] pt p        (*-> ([3,2],Res)*);
neuper@37906
   572
 val p = move_dn [] pt p        (*-> ([3],Res)*);
neuper@37906
   573
(* term2str (get_obj g_res pt [3]);
neuper@37906
   574
   term2str (get_obj g_form pt [4]);
neuper@37906
   575
   *)
neuper@37906
   576
 val p = move_dn [] pt p        (*-> ([4],Res)*);
neuper@37906
   577
 val p = move_dn [] pt p        (*-> ([],Res)*);
neuper@37906
   578
(*
neuper@37906
   579
 val p = (move_dn [] pt p) handle e => print_exn_G e;
neuper@37906
   580
                                  Exception PTREE end of calculation*)
akargl@42193
   581
neuper@38031
   582
if p=([],Res) then () else error "ctree.sml: diff:behav. in move_dn";
neuper@37906
   583
neuper@37906
   584
"-------------- move_dn: Frm -> Res ------------------------------";
neuper@37906
   585
"-------------- move_dn: Frm -> Res ------------------------------";
neuper@37906
   586
"-------------- move_dn: Frm -> Res ------------------------------";
akargl@42202
   587
 states := [];
neuper@37906
   588
 CalcTree      (*start of calculation, return No.1*)
neuper@42124
   589
     [(["equality (1+-1*2+x=(0::real))", "solveFor x","solutions L"],
neuper@38058
   590
       ("Test", 
neuper@37906
   591
	["linear","univariate","equation","test"],
neuper@37906
   592
	["Test","solve_linear"]))];
neuper@37906
   593
 Iterator 1; moveActiveRoot 1;
neuper@37906
   594
 autoCalculate 1 CompleteCalcHead;
neuper@37906
   595
 autoCalculate 1 (Step 1);
neuper@37906
   596
 refFormula 1 (get_pos 1 1);
neuper@37906
   597
neuper@37906
   598
 moveActiveRoot 1;
neuper@37906
   599
 moveActiveDown 1;
neuper@37906
   600
 if get_pos 1 1 = ([1], Frm) then () 
neuper@38031
   601
 else error "ctree.sml: diff.behav. in move_dn: Frm -> Res (1)";
neuper@37906
   602
 moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
neuper@37906
   603
neuper@37906
   604
 autoCalculate 1 (Step 1);
neuper@37906
   605
 refFormula 1 (get_pos 1 1);
neuper@37906
   606
neuper@37906
   607
 moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
neuper@37906
   608
 if get_pos 1 1 = ([1], Res) then () 
neuper@38031
   609
 else error "ctree.sml: diff.behav. in move_dn: Frm -> Res (1)";
akargl@42202
   610
 moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
neuper@37906
   611
neuper@37906
   612
neuper@37906
   613
"-------------- move_up ------------------------------------------";
neuper@37906
   614
"-------------- move_up ------------------------------------------";
neuper@37906
   615
"-------------- move_up ------------------------------------------";
neuper@37906
   616
 val p = move_up [] pt ([],Res); (*-> ([4],Res)*)
neuper@37906
   617
 val p = move_up [] pt p;        (*-> ([3],Res)*)
neuper@37906
   618
 val p = move_up [] pt p;        (*-> ([3,2],Res)*)
neuper@37906
   619
 val p = move_up [] pt p;        (*-> ([3,1],Res)*)
neuper@37906
   620
 val p = move_up [] pt p;        (*-> ([3,1],Frm)*)
neuper@37906
   621
 val p = move_up [] pt p;        (*-> ([3],Pbl)*)
neuper@37906
   622
 val p = move_up [] pt p;        (*-> ([2],Res)*)
neuper@37906
   623
 val p = move_up [] pt p;        (*-> ([1],Res)*)
neuper@37906
   624
 val p = move_up [] pt p;        (*-> ([1],Frm)*)
neuper@37906
   625
 val p = move_up [] pt p;        (*-> ([],Pbl)*)
neuper@37906
   626
(*val p = (move_up [] pt p) handle e => print_exn_G e;
neuper@37906
   627
                                  Exception PTREE begin of calculation*)
akargl@42193
   628
neuper@38031
   629
if p=([],Pbl) then () else error "ctree.sml: diff.behav. in move_up";
neuper@37906
   630
neuper@37906
   631
"------ move into detail -----------------------------------------";
neuper@37906
   632
"------ move into detail -----------------------------------------";
neuper@37906
   633
"------ move into detail -----------------------------------------";
neuper@37906
   634
 states:=[];
neuper@41970
   635
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   636
   ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   637
    ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   638
 Iterator 1; moveActiveRoot 1;
neuper@37906
   639
 autoCalculate 1 CompleteCalc; 
neuper@37906
   640
 moveActiveRoot 1; 
neuper@37906
   641
 moveActiveDown 1;
neuper@37906
   642
 moveActiveDown 1;
neuper@37906
   643
 moveActiveDown 1; 
neuper@37906
   644
 refFormula 1 (get_pos 1 1) (* 2 Res, <ISA> -1 + x = 0 </ISA> *);
neuper@37906
   645
neuper@37906
   646
 interSteps 1 ([2],Res);
neuper@37906
   647
neuper@37906
   648
 val ((pt,_),_) = get_calc 1; show_pt pt;
neuper@37906
   649
 val p = get_pos 1 1;
neuper@37906
   650
neuper@37906
   651
 val p = move_up [] pt p;     (*([2, 6], Res)*);
neuper@37906
   652
 val p = movelevel_up [] pt p;(*([2], Frm)*);
neuper@37906
   653
 val p = move_dn [] pt p;     (*([2, 1], Frm)*); 
neuper@37906
   654
 val p = move_dn [] pt p;     (*([2, 1], Res)*);
neuper@37906
   655
 val p = move_dn [] pt p;     (*([2, 2], Res)*);
neuper@37906
   656
 val p = move_dn [] pt p;     (*([2, 3], Res)*);
neuper@37906
   657
 val p = move_dn [] pt p;     (*([2, 4], Res)*);
neuper@37906
   658
 val p = move_dn [] pt p;     (*([2, 5], Res)*);
neuper@37906
   659
 val p = move_dn [] pt p;     (*([2, 6], Res)*); 
neuper@37906
   660
 if p = ([2, 6], Res) then() 
neuper@38031
   661
 else error "ctree.sml: diff.behav. in move into detail";
neuper@37906
   662
neuper@37906
   663
"=====new ptree 3a ===============================================";
neuper@37906
   664
"=====new ptree 3a ===============================================";
neuper@37906
   665
"=====new ptree 3a ===============================================";
neuper@37906
   666
 states:=[];
neuper@41970
   667
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   668
   ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   669
    ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   670
 Iterator 1; moveActiveRoot 1;
neuper@37906
   671
 autoCalculate 1 CompleteCalcHead; 
neuper@37906
   672
 autoCalculate 1 (Step 1); 
neuper@37906
   673
 autoCalculate 1 (Step 1); 
neuper@37906
   674
 autoCalculate 1 (Step 1);
neuper@37906
   675
 val ((pt,_),_) = get_calc 1;
neuper@37906
   676
 val p = move_dn [] pt ([],Pbl)       (*-> ([1], Frm)*); 
neuper@37906
   677
 val p = move_dn [] pt ([1], Frm)     (*-> ([1], Res)*); 
neuper@37906
   678
 val p = move_dn [] pt ([1], Res)     (*-> ([2], Res)*); 
neuper@37906
   679
 (*val p = move_dn [] pt ([2], Res)     ->Exception- PTREE "[] not complete"*);
neuper@37906
   680
neuper@37906
   681
 moveDown 1 ([],Pbl)        (*-> ([1], Frm)*);
neuper@37906
   682
 moveDown 1 ([1],Frm)       (*-> ([1],Res)*);
neuper@37906
   683
 moveDown 1 ([1],Res)       (*-> ([2],Res)*);
neuper@37906
   684
 moveDown 1 ([2],Res)       (*-> pos does not exist*);
neuper@37906
   685
(*
neuper@37906
   686
 get_obj g_ostate pt [1];
neuper@37906
   687
 show_pt pt; 
neuper@37906
   688
*)
neuper@37906
   689
neuper@37906
   690
"-------------- move_dn in Incomplete ctree ----------------------";
neuper@37906
   691
"-------------- move_dn in Incomplete ctree ----------------------";
neuper@37906
   692
"-------------- move_dn in Incomplete ctree ----------------------";
neuper@37906
   693
neuper@37906
   694
neuper@37906
   695
neuper@37906
   696
"=====new ptree 4: crooked by cut_level_'_ =======================";
neuper@37906
   697
"=====new ptree 4: crooked by cut_level_'_ =======================";
neuper@37906
   698
"=====new ptree 4: crooked by cut_level_'_ =======================";
neuper@37906
   699
states:=[];
neuper@37906
   700
CalcTree
neuper@37906
   701
[(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
neuper@37906
   702
	   "solveFor x","solutions L"], 
neuper@38058
   703
  ("RatEq",["univariate","equation"],["no_met"]))];
neuper@37906
   704
Iterator 1; moveActiveRoot 1;
neuper@37906
   705
autoCalculate 1 CompleteCalc; 
neuper@37906
   706
neuper@37906
   707
getTactic 1 ([1],Res);(*Rewrite_Set RatEq_simplify*)
neuper@37906
   708
getTactic 1 ([2],Res);(*Rewrite_Set norm_Rational*)
neuper@37906
   709
getTactic 1 ([3],Res);(*Rewrite_Set RatEq_eliminate*)
neuper@37906
   710
getTactic 1 ([4,1],Res);(*Rewrite all_left*)
neuper@37906
   711
getTactic 1 ([4,2],Res);(*Rewrite_Set expand_binoms*)
neuper@37906
   712
getTactic 1 ([4,3],Res);(*Rewrite_Set_Inst make_ratpoly_in*)
neuper@37906
   713
neuper@37906
   714
moveActiveFormula 1 ([1],Res)(*1.1...1.4*);
neuper@37906
   715
moveActiveFormula 1 ([2],Res)(**ME_Isa: 'expand' not known*);
neuper@37906
   716
moveActiveFormula 1 ([3],Res)(*3.1.*);
neuper@37906
   717
moveActiveFormula 1 ([4,2],Res)(*4.2.1.*);
neuper@37906
   718
moveActiveFormula 1 ([4,3],Res)(**one_scr_arg: called by Script Stepwise t_=*);
neuper@37906
   719
neuper@37906
   720
moveActiveFormula 1 ([1],Res)(*1.1...1.4*);
neuper@37906
   721
interSteps 1 ([1],Res)(*..is activeFormula !?!*);
neuper@37906
   722
neuper@37906
   723
getTactic 1 ([1,1],Res);(*Rewrite real_diff_minus*)
neuper@37906
   724
getTactic 1 ([1,2],Res);(*Rewrite real_diff_minus*)
neuper@37906
   725
getTactic 1 ([1,3],Res);(*Rewrite real_diff_minus*)
neuper@37906
   726
getTactic 1 ([1,4],Res);(*Rewrite real_rat_mult_1*)
neuper@37906
   727
neuper@37906
   728
moveActiveFormula 1 ([4,2],Res)(*4.2.1.*);
neuper@37906
   729
interSteps 1 ([4,2],Res)(*..is activeFormula !?!*);
neuper@37906
   730
val ((pt,_),_) = get_calc 1;
neuper@37906
   731
writeln(pr_ptree pr_short pt);
neuper@37906
   732
(*delete [4,1] in order to make pos [4],[4,4] for pblobjs differen [4],[4,3]:
neuper@37906
   733
 ###########################################################################*)
neuper@37906
   734
val (pt, ppp) = cut_level_'_ [] [] pt ([4,1],Frm);
neuper@37906
   735
writeln(pr_ptree pr_short pt);
neuper@37906
   736
neuper@37906
   737
akargl@42190
   738
akargl@42190
   739
akargl@42190
   740
neuper@37906
   741
"-------------- get_interval from ctree: incremental development--";
neuper@37906
   742
"-------------- get_interval from ctree: incremental development--";
neuper@37906
   743
"-------------- get_interval from ctree: incremental development--";
neuper@37906
   744
"--- level 1: get pos from start b to end p ----------------------";
neuper@37906
   745
"--- level 1: get pos from start b to end p ----------------------";
neuper@37906
   746
"--- level 1: get pos from start b to end p ----------------------";
neuper@37906
   747
(******************************************************************)
neuper@37906
   748
(**)            val SAVE_get_trace = get_trace;                 (**)
neuper@37906
   749
(******************************************************************)
neuper@37906
   750
(*'getnds' below is structured as such:*)
neuper@37906
   751
fun www _ [x] = "l+r-margin"
neuper@37906
   752
  | www true [x1,x2] = "l-margin,  r-margin"
neuper@37906
   753
  | www _ [x1,x2] = "intern,  r-margin"
neuper@37906
   754
  | www true (x::(xs as _::_)) = "l-margin  " ^ www false xs
neuper@37906
   755
  | www _ (x::(xs as _::_)) = "intern  " ^ www false xs;
neuper@37906
   756
www true [1,2,3,4,5];
neuper@37906
   757
(*val it = "from  intern  intern  intern  to" : string*)
neuper@37906
   758
www true [1,2];
neuper@37906
   759
(*val it = "from  to" : string*)
neuper@37906
   760
www true [1];
neuper@37906
   761
(*val it = "from+to" : string*)
neuper@37906
   762
neuper@37906
   763
local
neuper@37906
   764
(*specific values of hd of pos p,q for simple handling take_fromto,
neuper@37906
   765
  from-pos p, to-pos q: take_fromto (hdp p) (hdq q) (children pt) ...
neuper@37906
   766
  ... can be used even for positions _below_ p or q*)
neuper@37906
   767
fun hdp [] = 1     | hdp [0] = 1     | hdp x = hd x;(*start with first*)
neuper@37906
   768
fun hdq	[] = 99999 | hdq [0] = 99999 | hdq x = hd x;(*take until last*)
neuper@37906
   769
(*analoguous for tl*)
neuper@37906
   770
fun tlp [] = [0]     | tlp [_] = [0]     | tlp x = tl x;
neuper@37906
   771
fun tlq [] = [99999] | tlq [_] = [99999] | tlq x = tl x;
neuper@37906
   772
neuper@37906
   773
(*see modspec.sml#pt_form
neuper@37906
   774
fun pt_form (PrfObj {form,...}) = term2str form
neuper@37906
   775
  | pt_form (PblObj {probl,spec,origin=(_,spec',_),...}) =
neuper@37906
   776
    let val (dI, pI, _) = get_somespec' spec spec'
neuper@37906
   777
	val {cas,...} = get_pbt pI
neuper@37906
   778
    in case cas of
neuper@37926
   779
	   NONE => term2str (pblterm dI pI)
neuper@37926
   780
	 | SOME t => term2str (subst_atomic (mk_env probl) t)
neuper@37906
   781
    end;
neuper@37906
   782
*)
neuper@37906
   783
(*.get an 'interval' from ptree down to a certain level
neuper@37906
   784
   by 'take_fromto children' of the nodes with specific 'from' and 'to';
neuper@37906
   785
   'i > 0' suppresses output during recursive descent towards 'from'
neuper@37906
   786
   b: the 'from' incremented to the actual pos
neuper@37906
   787
   p,q: specific 'from','to' for simple use of 'take_fromto'*)
neuper@37906
   788
fun getnd i (b,p) q (Nd (po, nds)) =
neuper@37906
   789
    (if  i <= 0 then [(*[(b, pt_form po)]*) (**)[b](**)] else [])
neuper@37906
   790
 
neuper@37906
   791
    @ (writeln("getnd  : b="^(ints2str' b)^", p="^
neuper@37906
   792
	       (ints2str' p)^", q="^(ints2str' q));
neuper@37906
   793
neuper@37906
   794
       getnds (i-1) true (b@[hdp p], tlp p) (tlq q)
neuper@37906
   795
	       (take_fromto (hdp p) (hdq q) nds))
neuper@37906
   796
neuper@37906
   797
and getnds _ _ _ _ [] = []                         (*no children*)
neuper@37906
   798
  | getnds i _ (b,p) q [nd] = (getnd i (b,p) q nd) (*l+r-margin*)
neuper@37906
   799
  | getnds i true (b,p) q [n1, n2] =               (*l-margin,  r-margin*)
neuper@37906
   800
    (writeln("getnds3: b="^ ints2str' b ^", p="^ ints2str' p ^
neuper@37906
   801
	     ", q="^ ints2str' q);
neuper@37906
   802
    (getnd i      (       b, p ) [99999] n1) @
neuper@37906
   803
    (getnd ~99999 (lev_on b,[0]) q       n2))
neuper@37906
   804
  | getnds i _    (b,p) q [n1, n2] =               (*intern,  r-margin*)
neuper@37906
   805
    (writeln("getnds4: b="^ ints2str' b ^", p="^ ints2str' p ^
neuper@37906
   806
	     ", q="^ ints2str' q);
neuper@37906
   807
    (getnd i      (       b,[0]) [99999] n1) @
neuper@37906
   808
    (getnd ~99999 (lev_on b,[0]) q       n2))
neuper@37906
   809
  | getnds i true (b,p) q (nd::(nds as _::_)) =    (*l-margin, intern*)
neuper@37906
   810
    (writeln("getnds5: b="^ ints2str' b ^", p="^ ints2str' p ^
neuper@37906
   811
	     ", q="^ ints2str' q);
neuper@37906
   812
    (getnd i             (       b, p ) [99999] nd) @
neuper@37906
   813
    (getnds ~99999 false (lev_on b,[0]) q nds)) 
neuper@37906
   814
  | getnds i _ (b,p) q (nd::(nds as _::_)) =       (*intern, ...*)
neuper@37906
   815
    (getnd i             (       b,[0]) [99999] nd) @
neuper@37906
   816
    (getnds ~99999 false (lev_on b,[0]) q nds); 
neuper@37906
   817
in
neuper@37906
   818
(*get an 'interval from to' from a ptree as 'intervals f t' of respective nodes
neuper@37906
   819
  where 'from' are pos, i.e. a key as int list, 'f' an int (to,t analoguous)
neuper@37906
   820
(1) the 'f' are given 
neuper@37906
   821
(1a) by 'from' if 'f' = the respective element of 'from' (left margin)
neuper@37906
   822
(1b) -inifinity, if 'f' > the respective element of 'from' (internal node)
neuper@37906
   823
(2) the 't' ar given
neuper@37906
   824
(2a) by 'to' if 't' = the respective element of 'to' (right margin)
neuper@37906
   825
(2b) inifinity, if 't' < the respective element of 'to (internal node)'
neuper@37906
   826
the 'f' and 't' are set by hdp,... *)
neuper@37906
   827
fun get_trace pt p q =
neuper@37906
   828
    (flat o (getnds ((length p) -1) true ([hdp p], tlp p) (tlq q))) 
neuper@37906
   829
	(take_fromto (hdp p) (hdq q) (children pt));
neuper@37906
   830
end;
neuper@37906
   831
neuper@37906
   832
writeln(pr_ptree pr_short pt);
akargl@42193
   833
neuper@37906
   834
case get_trace pt [1,3] [4,1,1] of
neuper@37906
   835
    [[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1]] => () 
neuper@38031
   836
  | _ => error "diff.behav.in ctree.sml: get_interval lev 1a";
neuper@37906
   837
case get_trace pt [2] [4,3,2] of
neuper@37906
   838
    [[2],[3],[4],[4,1],[4,1,1],[4,2],[4,3],[4,3,1],[4,3,2]] => ()
neuper@38031
   839
  | _ => error "diff.behav.in ctree.sml: get_interval lev 1b";
neuper@37906
   840
case get_trace pt [1,4] [4,3,1] of
neuper@37906
   841
    [[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],[4,3],[4,3,1]] => () 
neuper@38031
   842
  | _ => error "diff.behav.in ctree.sml: get_interval lev 1c";
akargl@42193
   843
akargl@42193
   844
(*========== inhibit exn AK110719 ==============================================
neuper@37906
   845
case get_trace pt [4,2] [5] of
neuper@37906
   846
   (*[([4,2],_),([4,3],_),([4,4],_),([4,4,1],_),([4,4,2],_),([4,4,3],_),
neuper@37906
   847
    ([4,4,4],_),([4,4,5],_),([5],_)] => () ..with pt_form*)
neuper@37906
   848
    [[4,2],[4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5],[5]]=>()
neuper@38031
   849
  | _ => error "diff.behav.in ctree.sml: get_interval lev 1d";
akargl@42193
   850
========== inhibit exn AK110719 ==============================================*)
akargl@42193
   851
neuper@37906
   852
case get_trace pt [] [4,4,2] of
neuper@37906
   853
    [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],
neuper@37906
   854
     [4,3],[4,3,1],[4,3,2]] => () 
neuper@38031
   855
  | _ => error "diff.behav.in ctree.sml: get_interval lev 1e";
akargl@42193
   856
akargl@42193
   857
(*========== inhibit exn AK110719 ==============================================
neuper@37906
   858
case get_trace pt [] [] of
neuper@37906
   859
    [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],
neuper@37906
   860
     [4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5],[5]] => () 
neuper@38031
   861
  | _ => error "diff.behav.in ctree.sml: get_interval lev 1f";
neuper@37906
   862
case get_trace pt [4,3] [4,3] of
neuper@37906
   863
    [[4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5]] => () 
neuper@38031
   864
  | _ => error "diff.behav.in ctree.sml: get_interval lev 1g";
akargl@42120
   865
========== inhibit exn AK110719 ==============================================*)
neuper@37906
   866
neuper@37906
   867
"--- level 2: get pos' from start b to end p ---------------------";
neuper@37906
   868
"--- level 2: get pos' from start b to end p ---------------------";
neuper@37906
   869
"--- level 2: get pos' from start b to end p ---------------------";
neuper@37906
   870
(*idea: pos_ is _ONLY_ relevant exactly at (endpoint of) from, to
neuper@37906
   871
  development stopped in favour of move_dn, see get_interval
neuper@37906
   872
  actually used (inefficient) version with move_dn: see modspec.sml
neuper@37906
   873
*)
neuper@37906
   874
(*
neuper@37906
   875
case get_trace pt ([1,4],Res) ([4,4,1],Frm) of
neuper@37906
   876
    [[2],[3],[4],[4,1],[4,2],[4,2,1],[4,3],[4,4],[4,4,1]] => () 
neuper@38031
   877
  | _ => error "diff.behav.in ctree.sml: get_interval lev 1b";
neuper@37906
   878
case get_trace pt ([],Pbl) ([],Res) of
neuper@37906
   879
    [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,2],[4,2,1],[4,3],
neuper@37906
   880
     [4,4],[4,4,1],[4,4,2],[4,4,3],[4,4,4],[4,4,5],[5]] => () 
neuper@38031
   881
  | _ => error "diff.behav.in ctree.sml: get_interval lev 1e";
neuper@37906
   882
*)
neuper@37906
   883
neuper@37906
   884
(******************************************************************)
neuper@37906
   885
(**)            val get_trace = SAVE_get_trace;                 (**)
neuper@37906
   886
(******************************************************************)
neuper@37906
   887
neuper@37906
   888
neuper@37906
   889
"=====new ptree 4 ratequation ====================================";
neuper@37906
   890
"=====new ptree 4 ratequation ====================================";
neuper@37906
   891
"=====new ptree 4 ratequation ====================================";
neuper@37906
   892
states:=[];
neuper@37906
   893
CalcTree
neuper@37906
   894
[(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
neuper@37906
   895
	   "solveFor x","solutions L"], 
neuper@38058
   896
  ("RatEq",["univariate","equation"],["no_met"]))];
neuper@37906
   897
Iterator 1; moveActiveRoot 1;
neuper@37906
   898
autoCalculate 1 CompleteCalc; 
neuper@37906
   899
val ((pt,_),_) = get_calc 1;
neuper@37906
   900
show_pt pt;
neuper@37906
   901
neuper@37906
   902
neuper@37906
   903
"-------------- pt_extract form, tac, asm<>[] --------------------";
neuper@37906
   904
"-------------- pt_extract form, tac, asm<>[] --------------------";
neuper@37906
   905
"-------------- pt_extract form, tac, asm<>[] --------------------";
neuper@37926
   906
val (Form form, SOME tac, asm) = pt_extract (pt, ([3], Res));
neuper@37906
   907
case (term2str form, tac, terms2strs asm) of
neuper@37906
   908
    ("(3 + -1 * x + x ^^^ 2) * x = 1 * (9 * x + -6 * x ^^^ 2 + x ^^^ 3)",
neuper@37906
   909
     Subproblem
neuper@38058
   910
         ("PolyEq",
neuper@37906
   911
          ["normalize", "polynomial", "univariate", "equation"]),
neuper@37906
   912
	 ["9 * x + -6 * x ^^^ 2 + x ^^^ 3 ~= 0"]) => ()
neuper@38031
   913
  | _ => error "diff.behav.in ctree.sml: pt_extract asm<>[]";
neuper@37906
   914
(*WN060717 unintentionally changed some rls/ord while 
neuper@37906
   915
     completing knowl. for thes2file...
neuper@37906
   916
neuper@37906
   917
  case (term2str form, tac, terms2strs asm) of
neuper@37906
   918
    ((*"(3 + (-1 * x + x ^^^ 2)) * x = 1 * (9 * x + (x ^^^ 3 + -6 * x ^^^ 2))",
neuper@37906
   919
     *)Subproblem
neuper@38058
   920
         ("PolyEq",
neuper@37906
   921
          ["normalize", "polynomial", "univariate", "equation"]),
neuper@37906
   922
	 ["9 * x + (x ^^^ 3 + -6 * x ^^^ 2) ~= 0"]) => ()
neuper@38031
   923
  | _ => error "diff.behav.in ctree.sml: pt_extract asm<>[]";
neuper@37906
   924
neuper@37906
   925
.... but it became even better*)
neuper@37906
   926
neuper@37906
   927
neuper@37906
   928
neuper@37906
   929
"=====new ptree 5 minisubpbl =====================================";
neuper@37906
   930
"=====new ptree 5 minisubpbl =====================================";
neuper@37906
   931
"=====new ptree 5 minisubpbl =====================================";
neuper@37906
   932
states:=[];
neuper@41970
   933
CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   934
   ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   935
    ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   936
Iterator 1; moveActiveRoot 1;
neuper@37906
   937
autoCalculate 1 CompleteCalc; 
neuper@37906
   938
val ((pt,_),_) = get_calc 1;
neuper@37906
   939
show_pt pt;
neuper@37906
   940
neuper@37906
   941
"-------------- pt_extract form, tac, asm ------------------------";
neuper@37906
   942
"-------------- pt_extract form, tac, asm ------------------------";
neuper@37906
   943
"-------------- pt_extract form, tac, asm ------------------------";
neuper@37926
   944
val (ModSpec (_,_,form,_,_,_), SOME tac, asm) = pt_extract (pt, ([], Frm));
neuper@37906
   945
case (term2str form, tac, terms2strs asm) of
neuper@37906
   946
    ("solve (x + 1 = 2, x)", 
neuper@37906
   947
    Apply_Method ["Test", "squ-equ-test-subpbl1"],
neuper@37906
   948
     []) => ()
neuper@38031
   949
  | _ => error "diff.behav.in ctree.sml: pt_extract ([], Pbl)";
neuper@37906
   950
neuper@37926
   951
val (Form form, SOME tac, asm) = pt_extract (pt, ([1], Frm));
neuper@37906
   952
case (term2str form, tac, terms2strs asm) of
neuper@37906
   953
    ("x + 1 = 2", Rewrite_Set "norm_equation", []) => ()
neuper@38031
   954
  | _ => error "diff.behav.in ctree.sml: pt_extract ([1], Frm)";
neuper@37906
   955
neuper@37926
   956
val (Form form, SOME tac, asm) = pt_extract (pt, ([1], Res));
neuper@37906
   957
case (term2str form, tac, terms2strs asm) of
neuper@37906
   958
    ("x + 1 + -1 * 2 = 0", Rewrite_Set "Test_simplify", []) => ()
neuper@38031
   959
  | _ => error "diff.behav.in ctree.sml: pt_extract ([1], Res)";
neuper@37906
   960
neuper@37926
   961
val (Form form, SOME tac, asm) = pt_extract (pt, ([2], Res));
neuper@37906
   962
case (term2str form, tac, terms2strs asm) of
neuper@37906
   963
    ("-1 + x = 0",
neuper@38058
   964
     Subproblem ("Test", ["linear", "univariate", "equation", "test"]),
neuper@37906
   965
     []) => ()
neuper@38031
   966
  | _ => error "diff.behav.in ctree.sml: pt_extract ([2], Res)";
neuper@37906
   967
neuper@37926
   968
val (ModSpec (_,_,form,_,_,_), SOME tac, asm) = pt_extract (pt, ([3], Pbl));
neuper@37906
   969
case (term2str form, tac, terms2strs asm) of
neuper@37906
   970
    ("solve (-1 + x = 0, x)", Apply_Method ["Test", "solve_linear"], []) => ()
neuper@38031
   971
  | _ => error "diff.behav.in ctree.sml: pt_extract ([3], Pbl)";
neuper@37906
   972
neuper@37926
   973
val (Form form, SOME tac, asm) = pt_extract (pt, ([3,1], Frm));
neuper@37906
   974
case (term2str form, tac, terms2strs asm) of
neuper@37906
   975
    ("-1 + x = 0", Rewrite_Set_Inst (["(bdv, x)"], "isolate_bdv"), []) => ()
neuper@38031
   976
  | _ => error "diff.behav.in ctree.sml: pt_extract ([3,1], Frm)";
neuper@37906
   977
neuper@37926
   978
val (Form form, SOME tac, asm) = pt_extract (pt, ([3,1], Res));
neuper@37906
   979
case (term2str form, tac, terms2strs asm) of
neuper@37906
   980
    ("x = 0 + -1 * -1", Rewrite_Set "Test_simplify", []) => ()
neuper@38031
   981
  | _ => error "diff.behav.in ctree.sml: pt_extract ([3,1], Res)";
neuper@37906
   982
neuper@37926
   983
val (Form form, SOME tac, asm) = pt_extract (pt, ([3,2], Res));
neuper@37906
   984
case (term2str form, tac, terms2strs asm) of
neuper@37906
   985
    ("x = 1", Check_Postcond ["linear", "univariate", "equation", "test"], 
neuper@37906
   986
     []) => ()
neuper@38031
   987
  | _ => error "diff.behav.in ctree.sml: pt_extract ([3,2], Res)";
neuper@37906
   988
akargl@42120
   989
(*========== inhibit exn AK110719 ==============================================
neuper@37926
   990
val (Form form, SOME tac, asm) = pt_extract (pt, ([3], Res));
neuper@37906
   991
case (term2str form, tac, terms2strs asm) of
neuper@37906
   992
    ("[x = 1]", Check_elementwise "Assumptions", []) => ()
neuper@38031
   993
  | _ => error "diff.behav.in ctree.sml: pt_extract ([3], Res)";
neuper@37906
   994
neuper@37926
   995
val (Form form, SOME tac, asm) = pt_extract (pt, ([4], Res));
neuper@37906
   996
case (term2str form, tac, terms2strs asm) of
neuper@37906
   997
    ("[x = 1]",
neuper@37906
   998
     Check_Postcond ["sqroot-test", "univariate", "equation", "test"],
neuper@37906
   999
     []) => ()
neuper@38031
  1000
  | _ => error "diff.behav.in ctree.sml: pt_extract ([4], Res)";
neuper@37906
  1001
neuper@37906
  1002
val (Form form, tac, asm) = pt_extract (pt, ([], Res));
neuper@37906
  1003
case (term2str form, tac, terms2strs asm) of
neuper@37926
  1004
    ("[x = 1]", NONE, []) => ()
neuper@38031
  1005
  | _ => error "diff.behav.in ctree.sml: pt_extract ([], Res)";
akargl@42120
  1006
========== inhibit exn AK110719 ==============================================*)
neuper@37906
  1007
neuper@37906
  1008
"=====new ptree 6 minisubpbl intersteps ==========================";
neuper@37906
  1009
"=====new ptree 6 minisubpbl intersteps ==========================";
neuper@37906
  1010
"=====new ptree 6 minisubpbl intersteps ==========================";
neuper@37906
  1011
states:=[];
neuper@41970
  1012
CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
  1013
   ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
  1014
    ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
  1015
Iterator 1; moveActiveRoot 1;
neuper@37906
  1016
autoCalculate 1 CompleteCalc;
neuper@37906
  1017
interSteps 1 ([2],Res);
neuper@37906
  1018
interSteps 1 ([3,2],Res);
neuper@37906
  1019
val ((pt,_),_) = get_calc 1;
neuper@37906
  1020
show_pt pt;
neuper@37906
  1021
neuper@37906
  1022
(**##############################################################**)
neuper@37906
  1023
"-------------- get_allpos' new ----------------------------------";
neuper@37906
  1024
"-------------- get_allpos' new ----------------------------------";
neuper@37906
  1025
"-------------- get_allpos' new ----------------------------------";
neuper@37906
  1026
"--- whole ctree";
neuper@37906
  1027
print_depth 99;
neuper@37906
  1028
val cuts = get_allp [] ([], ([],Frm)) pt;
neuper@37906
  1029
print_depth 3;
neuper@37906
  1030
if cuts = 
neuper@37906
  1031
   [(*never returns the first pos'*)
neuper@37906
  1032
    ([1], Frm), 
neuper@37906
  1033
    ([1], Res), 
neuper@37906
  1034
    ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res), 
neuper@37906
  1035
    ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), 
neuper@37906
  1036
    ([2], Res),
neuper@37906
  1037
    ([3], Pbl), 
neuper@37906
  1038
    ([3, 1], Frm), ([3, 1], Res), 
neuper@37906
  1039
    ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res), 
neuper@37906
  1040
    ([3, 2], Res), 
neuper@37906
  1041
    ([3], Res),
neuper@37906
  1042
    ([4], Res), 
neuper@37906
  1043
    ([], Res)] then () else
neuper@38031
  1044
error "ctree.sml diff.behav. get_allp new []";
neuper@37906
  1045
neuper@37906
  1046
print_depth 99;
neuper@37906
  1047
val cuts2 = get_allps [] [1] (children pt);
neuper@37906
  1048
print_depth 3;
neuper@37906
  1049
if cuts = cuts2 @ [([], Res)] then () else
neuper@38031
  1050
error "ctree.sml diff.behav. get_allps new []";
neuper@37906
  1051
neuper@37906
  1052
"---(3) on S(606)..S(608)--------";
neuper@37906
  1053
"--- nd [2] with 6 children---------------------------------";
neuper@37906
  1054
val cuts = get_allp [] ([2], ([],Frm)) (get_nd pt [2]);
neuper@37906
  1055
if cuts = 
neuper@37906
  1056
   [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
neuper@37906
  1057
    ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), 
neuper@37906
  1058
    ([2], Res)] then () else
neuper@38031
  1059
error "ctree.sml diff.behav. get_allp new [2]";
neuper@37906
  1060
neuper@37906
  1061
val cuts2 = get_allps [] [2,1] (children (get_nd pt [2]));
neuper@37906
  1062
if cuts = cuts2 @ [([2], Res)] then () else
neuper@38031
  1063
error "ctree.sml diff.behav. get_allps new [2]";
neuper@37906
  1064
neuper@37906
  1065
neuper@37906
  1066
"---(4) on S(606)..S(608)--------";
neuper@37906
  1067
"--- nd [3] subproblem--------------------------------------";
neuper@37906
  1068
val cuts = get_allp [] ([3], ([],Frm)) (get_nd pt [3]);
neuper@37906
  1069
if cuts = 
neuper@37906
  1070
   [([3, 1], Frm), 
neuper@37906
  1071
    ([3, 1], Res), 
neuper@37906
  1072
    ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res), 
neuper@37906
  1073
    ([3, 2], Res), 
neuper@37906
  1074
    ([3], Res)] then () else
neuper@38031
  1075
error "ctree.sml diff.behav. get_allp new [3]";
neuper@37906
  1076
neuper@37906
  1077
val cuts2 = get_allps [] [3,1] (children (get_nd pt [3]));
neuper@37906
  1078
if cuts = cuts2 @ [([3], Res)] then () else
neuper@38031
  1079
error "ctree.sml diff.behav. get_allps new [3]";
neuper@37906
  1080
neuper@37906
  1081
"--- nd [3,2] with 2 children--------------------------------";
neuper@37906
  1082
val cuts = get_allp [] ([3,2], ([],Frm)) (get_nd pt [3,2]);
neuper@37906
  1083
if cuts = 
neuper@37906
  1084
   [([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res), 
neuper@37906
  1085
    ([3, 2], Res)] then () else
neuper@38031
  1086
error "ctree.sml diff.behav. get_allp new [3,2]";
neuper@37906
  1087
neuper@37906
  1088
val cuts2 = get_allps [] [3,2,1] (children (get_nd pt [3,2]));
neuper@37906
  1089
if cuts = cuts2 @ [([3, 2], Res)] then () else
neuper@38031
  1090
error "ctree.sml diff.behav. get_allps new [3,2]";
neuper@37906
  1091
neuper@37906
  1092
"---(5a) on S(606)..S(608)--------";
neuper@37906
  1093
"--- nd [3,2,1] with 0 children------------------------------";
neuper@37906
  1094
val cuts = get_allp [] ([3,2,1], ([],Frm)) (get_nd pt [3,2,1]);
neuper@37906
  1095
if cuts = 
neuper@37906
  1096
   [] then () else
neuper@38031
  1097
error "ctree.sml diff.behav. get_allp new [3,2,1]";
neuper@37906
  1098
neuper@37906
  1099
val cuts2 = get_allps [] [3,2,1,1] (children (get_nd pt [3,2,1]));
neuper@37906
  1100
if cuts = cuts2 @ [] then () else
neuper@38031
  1101
error "ctree.sml diff.behav. get_allps new [3,2,1]";
neuper@37906
  1102
neuper@37906
  1103
neuper@37906
  1104
(**#################################################################**)
neuper@37906
  1105
"-------------- cut_tree new (from ptree above)-------------------";
neuper@37906
  1106
"-------------- cut_tree new (from ptree above)-------------------";
neuper@37906
  1107
"-------------- cut_tree new (from ptree above)-------------------";
neuper@37906
  1108
show_pt pt;
neuper@37906
  1109
val b = get_obj g_branch pt [];
neuper@37906
  1110
if b = TransitiveB then () else
neuper@38031
  1111
error ("ctree.sml diff.behav. in [] branch="^branch2str b);
neuper@37906
  1112
val b = get_obj g_branch pt [3];
neuper@37906
  1113
if b = TransitiveB then () else
neuper@38031
  1114
error ("ctree.sml diff.behav. in [3] branch="^branch2str b);
neuper@37906
  1115
neuper@37906
  1116
"---(2) on S(606)..S(608)--------";
neuper@37906
  1117
val (pt', cuts) = cut_tree pt ([1],Res);
neuper@37906
  1118
print_depth 99;
neuper@37906
  1119
cuts;
neuper@37906
  1120
print_depth 3;
neuper@37906
  1121
if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
neuper@37906
  1122
      ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl),
neuper@37906
  1123
      ([3, 1], Frm), ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res),
neuper@37906
  1124
      ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
neuper@37906
  1125
(*WN060727 after replacing cutlevup by test_trans:*)([], Res)] then () else 
neuper@38031
  1126
error "ctree.sml: diff.behav. cut_tree ([1],Res)";
neuper@37906
  1127
neuper@37906
  1128
neuper@37906
  1129
"---(3) on S(606)..S(608)--------";
neuper@37906
  1130
val (pt', cuts) = cut_tree pt ([2],Res);
neuper@37906
  1131
print_depth 99;
neuper@37906
  1132
cuts;
neuper@37906
  1133
print_depth 3;
neuper@37906
  1134
if cuts = [(*preceding step on WS was ([1]),Res*)
neuper@37906
  1135
	   ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
neuper@37906
  1136
	   ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), 
neuper@37906
  1137
	   ([2], Res),
neuper@37906
  1138
	   ([3], Pbl), 
neuper@37906
  1139
	   ([3, 1], Frm),
neuper@37906
  1140
	   ([3, 1], Res), 
neuper@37906
  1141
	   ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
neuper@37906
  1142
	   ([3, 2], Res), 
neuper@37906
  1143
	   ([3], Res), 
neuper@37906
  1144
	   ([4], Res),
neuper@37906
  1145
(*WN060727 added after replacing cutlevup by test_trans:*)([],Res)] then () 
neuper@38031
  1146
else error "ctree.sml: diff.behav. cut_tree ([2],Res)";
neuper@37906
  1147
neuper@37906
  1148
"---(4) on S(606)..S(608)--------";
neuper@37906
  1149
val (pt', cuts) = cut_tree pt ([3],Pbl);
neuper@37906
  1150
print_depth 99;
neuper@37906
  1151
cuts;
neuper@37906
  1152
print_depth 3;
neuper@37906
  1153
if cuts = [([3], Pbl),
neuper@37906
  1154
	   ([3, 1], Frm), ([3, 1], Res), 
neuper@37906
  1155
	   ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res), 
neuper@37906
  1156
	   ([3, 2], Res), 
neuper@37906
  1157
	   ([3], Res), 
neuper@37906
  1158
	   ([4], Res),
neuper@37906
  1159
(*WN060727 added after replacing cutlevup by test_trans:*)([], Res)] 
neuper@38031
  1160
then () else error "ctree.sml: diff.behav. cut_tree ([3],Pbl)";
neuper@37906
  1161
neuper@37906
  1162
"---(5a) on S(606)..S(608) cut_tree --------";
neuper@37906
  1163
val (pt', cuts) = cut_tree pt ([3,2,1],Res);
neuper@37906
  1164
print_depth 99;
neuper@37906
  1165
cuts;
neuper@37906
  1166
print_depth 1;
neuper@37906
  1167
if cuts = [([3, 2, 2], Res), ([3, 2], Res),
neuper@37906
  1168
(*WN060727 added after replacing cutlevup by test_trans:*)
neuper@37906
  1169
([3], Res), ([4], Res),([],Res)] then () 
neuper@38031
  1170
else error "ctree.sml: diff.behav. cut_tree ([3,2,1],Res)";
neuper@37906
  1171
show_pt pt';
neuper@37906
  1172
neuper@37906
  1173
neuper@37906
  1174
"-------------- cappend on complete ctree from above -------------";
neuper@37906
  1175
"-------------- cappend on complete ctree from above -------------";
neuper@37906
  1176
"-------------- cappend on complete ctree from above -------------";
neuper@37906
  1177
show_pt pt;
neuper@37906
  1178
neuper@37906
  1179
"---(2) on S(606)..S(608)--------";
akargl@42193
  1180
(*========== inhibit exn AK110726 ==============================================
akargl@42193
  1181
(* ERROR: Can't unify istate to istate * Proof.context *)
neuper@37906
  1182
val (pt', cuts) = cappend_atomic pt [1] e_istate (str2term "Inform[1]")
neuper@37906
  1183
    (Tac "test") (str2term "Inres[1]",[]) Complete;
akargl@42120
  1184
neuper@37906
  1185
print_depth 99;
neuper@37906
  1186
cuts;
neuper@37906
  1187
print_depth 3;
neuper@37906
  1188
if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
neuper@37906
  1189
      ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl),
neuper@37906
  1190
      ([3, 1], Frm), ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res),
neuper@37906
  1191
      ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
neuper@37906
  1192
(*WN060727 added after replacing cutlevup by test_trans:*) ([], Res)] then ()
neuper@38031
  1193
else error "ctree.sml: diff:behav. in complete pt:append_atomic[1] cuts";
akargl@42120
  1194
neuper@37906
  1195
val afterins = get_allp [] ([], ([],Frm)) pt';
neuper@37906
  1196
print_depth 99;
neuper@37906
  1197
afterins;
neuper@37906
  1198
print_depth 3;
neuper@37906
  1199
if afterins = [([1], Frm), ([1], Res)
neuper@37906
  1200
(*, WN060727 removed after replacing cutlevup by test_trans:([], Res)*)] then()
neuper@38031
  1201
else error "ctree.sml: diff:behav. in complete pt: append_atomic[1] afterins";
neuper@37906
  1202
show_pt pt';
neuper@37906
  1203
"---(3) on S(606)..S(608)--------";
neuper@37906
  1204
show_pt pt;
neuper@37906
  1205
val (pt', cuts) = cappend_atomic pt [2] e_istate (str2term "Inform[2]")
neuper@37906
  1206
    (Tac "test") (str2term "Inres[2]",[]) Complete;
neuper@37906
  1207
print_depth 99;
neuper@37906
  1208
cuts;
neuper@37906
  1209
print_depth 3;
akargl@42193
  1210
neuper@37906
  1211
if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
neuper@37906
  1212
      ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl), 
neuper@37906
  1213
      ([3, 1], Frm),([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res), 
neuper@37906
  1214
      ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
neuper@37906
  1215
(*WN060727 added after replacing cutlevup by test_trans:*) ([], Res)] then () 
neuper@38031
  1216
else error "ctree.sml: diff:behav.in complete pt: append_atomic[2] cuts";
akargl@42193
  1217
akargl@42193
  1218
neuper@37906
  1219
val afterins = get_allp [] ([], ([],Frm)) pt';
neuper@37906
  1220
print_depth 99;
neuper@37906
  1221
afterins;
neuper@37906
  1222
print_depth 3;
akargl@42193
  1223
neuper@37906
  1224
if afterins = [([1], Frm), ([1], Res), ([2], Frm), ([2], Res)
neuper@37906
  1225
(*,  WN060727 removed after replacing cutlevup by test_trans:([], Res)*)] 
neuper@37906
  1226
then () else
neuper@38031
  1227
error "ctree.sml: diff:behav. in complete pt: append_atomic[2] afterins";
neuper@37906
  1228
show_pt pt';
akargl@42193
  1229
akargl@42193
  1230
neuper@37906
  1231
(*
neuper@37906
  1232
 val p = move_dn [] pt' ([],Pbl) (*-> ([1],Frm)*);
neuper@37906
  1233
 val p = move_dn [] pt' p        (*-> ([1],Res)*);
neuper@37906
  1234
 val p = move_dn [] pt' p        (*-> ([2],Frm)*);
neuper@37906
  1235
 val p = move_dn [] pt' p        (*-> ([2],Res)*);
neuper@37906
  1236
neuper@37906
  1237
 term2str (get_obj g_form pt' [2]);
neuper@37906
  1238
 term2str (get_obj g_res pt' [2]);
neuper@37906
  1239
 ostate2str (get_obj g_ostate pt' [2]);
neuper@37906
  1240
 *)
neuper@37906
  1241
neuper@37906
  1242
"---(4) on S(606)..S(608)--------";
neuper@37906
  1243
val (pt', cuts) = cappend_problem pt [3] e_istate ([],e_spec)
neuper@37906
  1244
				  ([],e_spec, str2term "Inhead[3]");
neuper@37906
  1245
print_depth 99;
neuper@37906
  1246
cuts;
neuper@37906
  1247
print_depth 3;
neuper@37906
  1248
if cuts = [([3], Pbl),
neuper@37906
  1249
	   ([3, 1], Frm), ([3, 1], Res), 
neuper@37906
  1250
	   ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res), 
neuper@37906
  1251
	   ([3, 2], Res), 
neuper@37906
  1252
	   ([3], Res), ([4], Res),
neuper@37906
  1253
(*WN060727 added after replacing cutlevup by test_trans*)([], Res)] then ()else
neuper@38031
  1254
error "ctree.sml: diff:behav. in ccomplete pt: append_problem[3] cuts";
neuper@37906
  1255
val afterins = get_allp [] ([], ([],Frm)) pt';
neuper@37906
  1256
print_depth 99;
neuper@37906
  1257
afterins;
neuper@37906
  1258
print_depth 3;
neuper@37906
  1259
if afterins = 
neuper@37906
  1260
   [([1], Frm), ([1], Res),([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
neuper@37906
  1261
    ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res),
neuper@37906
  1262
    ([3], Pbl)] then () else
neuper@38031
  1263
error "ctree.sml: diff:behav.in complete pt: append_problem[3] afterins";
neuper@37906
  1264
(* use"systest/ctree.sml";
neuper@37906
  1265
   use"ctree.sml";
neuper@37906
  1266
   *)
neuper@37906
  1267
neuper@37906
  1268
"---(6-1) on S(606)..S(608)--------";
neuper@37906
  1269
val (pt', cuts) = cappend_atomic pt [3,1] e_istate (str2term "Inform[3,1]")
neuper@37906
  1270
    (Tac "test") (str2term "Inres[3,1]",[]) Complete;
neuper@37906
  1271
print_depth 99;
neuper@37906
  1272
cuts;
neuper@37906
  1273
print_depth 3;
neuper@37906
  1274
if cuts = [([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res), 
neuper@37906
  1275
	   ([3, 2], Res),
neuper@37906
  1276
(*WN060727 added*)([3], Res), ([4], Res), ([], Res)] then () else
neuper@38031
  1277
error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] cuts";
akargl@42120
  1278
neuper@37906
  1279
val afterins = get_allp [] ([], ([],Frm)) pt';
neuper@37906
  1280
print_depth 99;
neuper@37906
  1281
afterins;
neuper@37906
  1282
print_depth 3;
neuper@37906
  1283
(*WN060727 replaced after overwriting cutlevup by test_trans
neuper@37906
  1284
if afterins = [([1], Frm), ([1], Res), 
neuper@37906
  1285
	       ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
neuper@37906
  1286
	       ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), 
neuper@37906
  1287
	       ([2], Res),
neuper@37906
  1288
	       ([3], Pbl), 
neuper@37906
  1289
	       ([3, 1], Frm), ([3, 1], Res)(*replaced*), (*([3, 2], Res) cut!*)
neuper@37906
  1290
	       ([3], Res)(*cutlevup=false*), 
neuper@37906
  1291
	       ([4], Res),
neuper@37906
  1292
	       ([], Res)(*cutlevup=false*)] then () else
neuper@38031
  1293
error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] insrtd";
neuper@37906
  1294
*)
neuper@37906
  1295
if afterins = [([1], Frm), ([1], Res), 
neuper@37906
  1296
	       ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
neuper@37906
  1297
	       ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), 
neuper@37906
  1298
	       ([2], Res),
neuper@37906
  1299
	       ([3], Pbl), 
neuper@37906
  1300
	       ([3, 1], Frm), ([3, 1], Res)] then () else
neuper@38031
  1301
error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] insrtd";
neuper@37906
  1302
neuper@37906
  1303
if term2str (get_obj g_form pt' [3,1]) = "Inform [3, 1]" then () else
neuper@38031
  1304
error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] Inform";
neuper@37906
  1305
neuper@37906
  1306
"---(6) on S(606)..S(608)--------";
neuper@37906
  1307
val (pt', cuts) = cappend_atomic pt [3,2] e_istate (str2term "Inform[3,2]")
neuper@37906
  1308
    (Tac "test") (str2term "Inres[3,2]",[]) Complete;
neuper@37906
  1309
print_depth 99;
neuper@37906
  1310
cuts;
neuper@37906
  1311
print_depth 3;
neuper@37906
  1312
if cuts = [(*just after is: cutlevup=false in [3]*)
neuper@37906
  1313
(*WN060727 after test_trans instead cutlevup added:*)
neuper@37906
  1314
	   ([3], Res), ([4], Res), ([], Res)] then () else
neuper@38031
  1315
error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] cuts";
neuper@37906
  1316
val afterins = get_allp [] ([], ([],Frm)) pt';
neuper@37906
  1317
print_depth 99;
neuper@37906
  1318
afterins;
neuper@37906
  1319
print_depth 3;
neuper@37906
  1320
(*WN060727 replaced after overwriting cutlevup by test_trans
neuper@37906
  1321
if afterins = [([1], Frm), ([1], Res), 
neuper@37906
  1322
	       ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
neuper@37906
  1323
	       ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), 
neuper@37906
  1324
	       ([2], Res),
neuper@37906
  1325
	       ([3], Pbl), 
neuper@37906
  1326
	       ([3, 1], Frm), ([3, 1], Res), ([3, 2], Frm), ([3, 2], Res), 
neuper@37906
  1327
	       ([3], Res),
neuper@37906
  1328
	       ([4], Res), ([], Res)] then () else
neuper@38031
  1329
error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] insrtd";
neuper@37906
  1330
*)
neuper@37906
  1331
if afterins = [([1], Frm), ([1], Res), 
neuper@37906
  1332
	       ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
neuper@37906
  1333
	       ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), 
neuper@37906
  1334
	       ([2], Res),
neuper@37906
  1335
	       ([3], Pbl), 
neuper@37906
  1336
	       ([3, 1], Frm), ([3, 1], Res), ([3, 2], Frm), ([3, 2], Res)]
neuper@37906
  1337
then () else
neuper@38031
  1338
error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] insrtd";
neuper@37906
  1339
neuper@37906
  1340
if term2str (get_obj g_form pt' [3,2]) = "Inform [3, 2]" then () else
neuper@38031
  1341
error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] Inform";
neuper@37906
  1342
neuper@37906
  1343
"---(6++) on S(606)..S(608)--------";
neuper@37906
  1344
(**)
neuper@37906
  1345
val (pt', cuts) = cappend_atomic pt [3,2,1] e_istate (str2term "Inform[3,2,1]")
neuper@37906
  1346
    (Tac "test") (str2term "Inres[3,2,1]",[]) Complete;
neuper@37906
  1347
print_depth 99;
neuper@37906
  1348
cuts;
neuper@37906
  1349
print_depth 1;
neuper@37906
  1350
if cuts = [([3, 2, 2], Res), ([3, 2], Res),
neuper@37906
  1351
(*WN060727 {cutlevup->test_trans} added:*)([3], Res), ([4], Res), ([], Res)] 
neuper@37906
  1352
then () else
neuper@38031
  1353
error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2,1] cuts";
neuper@37906
  1354
val afterins = get_allp [] ([], ([],Frm)) pt';
neuper@37906
  1355
print_depth 99;
neuper@37906
  1356
afterins;
neuper@37906
  1357
print_depth 3;
neuper@37906
  1358
if afterins = [([1], Frm), ([1], Res), 
neuper@37906
  1359
	       ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
neuper@37906
  1360
	       ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), 
neuper@37906
  1361
	       ([2], Res),
neuper@37906
  1362
	       ([3], Pbl), 
neuper@37906
  1363
	       ([3, 1], Frm), ([3, 1], Res), 
neuper@37906
  1364
	       ([3, 2, 1], Frm), ([3, 2, 1], Res)] then () else
neuper@38031
  1365
error "ctree.sml: diff:behav. in complete pt: append_atom[3,2,1] insrtd";
neuper@37906
  1366
if term2str (get_obj g_form pt' [3,2,1]) = "Inform [3, 2, 1]" then () else
neuper@38031
  1367
error "ctree.sml: diff:behav. complete pt: append_atomic[3,2,1] Inform";
neuper@37906
  1368
(*
neuper@37906
  1369
show_pt pt';
neuper@37906
  1370
show_pt pt;
neuper@37906
  1371
*)
akargl@42193
  1372
========== inhibit exn AK110726 ==============================================*)