test/Tools/isac/Interpret/ctree.sml
author Walther Neuper <wneuper@ist.tugraz.at>
Mon, 20 Apr 2015 14:18:40 +0200
changeset 59111 c730b643bc0e
parent 55446 42c45d1241d7
child 59248 5eba5e6d5266
permissions -rw-r--r--
update test/ to Isabelle2014 (~ updates of src/)

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