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