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