test/Tools/isac/Interpret/script.sml
author Alexander Kargl <akargl@brgkepler.net>
Fri, 22 Jul 2011 15:57:22 +0200
branchdecompose-isar
changeset 42169 038eba5418b8
parent 42145 43e7e9f835b1
child 42214 f061b8826301
permissions -rw-r--r--
intermed: uncomment tests
neuper@41999
     1
(* Title:  test/../script.sml
neuper@41999
     2
   Author: Walther Neuper 050908
neuper@37906
     3
   (c) copyright due to lincense terms.
neuper@37906
     4
*)
neuper@37906
     5
"-----------------------------------------------------------------";
neuper@37906
     6
"table of contents -----------------------------------------------";
neuper@37906
     7
"-----------------------------------------------------------------";
neuper@37906
     8
"----------- WN0509 why does next_tac doesnt find Substitute -----";
neuper@37906
     9
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
    10
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@41969
    11
"----------- fun init_form, fun get_stac -------------------------";
neuper@41972
    12
"----------- x+1=2 start SubProblem 'stac2tac_ TODO: no match for ";
neuper@41982
    13
"----------- x+1=2 set ctxt in Subproblem ------------------------";
neuper@37906
    14
"-----------------------------------------------------------------";
neuper@37906
    15
"-----------------------------------------------------------------";
neuper@37906
    16
"-----------------------------------------------------------------";
neuper@37906
    17
neuper@37906
    18
neuper@37906
    19
"----------- WN0509 why does next_tac doesnt find Substitute -----";
neuper@37906
    20
"----------- WN0509 why does next_tac doesnt find Substitute -----";
neuper@37906
    21
"----------- WN0509 why does next_tac doesnt find Substitute -----";
neuper@37906
    22
neuper@37906
    23
(*replace met 'IntegrierenUndKonstanteBestimmen' with this script...*)
neuper@37906
    24
val str = (*#1#*)
akargl@42169
    25
"Script BiegelinieScript                                             " ^ 
akargl@42169
    26
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^ 
akargl@42169
    27
"(rb_rb::bool list) (rm_rm::bool list) =                             " ^
akargl@42169
    28
"  (let q___q = Take (M_b v_v = q__q);                               " ^
akargl@42169
    29
"       (M1__M1::bool) = ((Substitute [v_v = 0])) q___q              " ^
akargl@42169
    30
" in True)";
akargl@42169
    31
akargl@42145
    32
(*========== inhibit exn 110721 ================================================
akargl@42169
    33
(* ERROR: parse thy Can't unify theory to domID * rls*)
neuper@37906
    34
val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
akargl@42169
    35
========= inhibit exn 110721 ================================================*)
neuper@37906
    36
neuper@37906
    37
val str = (*#2#*)
akargl@42169
    38
"Script BiegelinieScript                                             " ^ 
akargl@42169
    39
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^ 
akargl@42169
    40
"(rb_rb::bool list) (rm_rm::bool list) =                             " ^ 
akargl@42169
    41
"       (M1__M1::bool) = ((Substitute [v_v = 0]) @@                  " ^
akargl@42169
    42
" in True)";(*..doesnt find Substitute with ..@@ !!!!!!!!!!!!!!!!!!!!!*)
neuper@37906
    43
neuper@37906
    44
val str = (*#3#*)
akargl@42169
    45
"Script BiegelinieScript                                             " ^
akargl@42169
    46
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^
akargl@42169
    47
"(rb_rb::bool list) (rm_rm::bool list) =                             " ^
akargl@42169
    48
"  (let q___q = Take (q_q v_v = q__q);                               " ^
akargl@42169
    49
"      (M1__M1::bool) = Substitute [v_v = 0]      q___q ;            " ^
akargl@42169
    50
"       M1__m1 =        Substitute [M_b 0 = 0]  M1__M1               " ^
akargl@42169
    51
" in True)"
neuper@37906
    52
;
neuper@37906
    53
val str = (*#4#*)
akargl@42169
    54
"Script BiegelinieScript                                             " ^
akargl@42169
    55
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^
akargl@42169
    56
"(rb_rb::bool list) (rm_rm::bool list) =                             " ^
akargl@42169
    57
"  (let q___q = Take (q_q v_v = q__q);                               " ^
akargl@42169
    58
"      (M1__M1::bool) = Substitute [v_v = 0]      q___q ;            " ^
akargl@42169
    59
"       M1__M1 =        Substitute [v_v = 1]      q___q ;            " ^
akargl@42169
    60
"       M1__M1 =        Substitute [v_v = 2]      q___q ;            " ^
akargl@42169
    61
"       M1__M1 =        Substitute [v_v = 3]      q___q ;            " ^
akargl@42169
    62
"       M1__M1 =        Substitute [M_b 0 = 0]  M1__M1               " ^
akargl@42169
    63
" in True)"
neuper@37906
    64
;
neuper@37906
    65
val str = (*#5#*)
akargl@42169
    66
"Script BiegelinieScript                                             " ^
akargl@42169
    67
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^
akargl@42169
    68
"(rb_rb::bool list) (rm_rm::bool list) =                             " ^
akargl@42169
    69
"  (let q___q = Take (M_b v_v = q__q);                               " ^
akargl@42169
    70
"      (M1__M1::bool) = Substitute [v_v = 0]      q___q ;            " ^
akargl@42169
    71
"       M2__M2 = Take q___q ;                                        " ^
akargl@42169
    72
"       M2__M2 =        Substitute [v_v = 2]      q___q              " ^
akargl@42169
    73
" in True)"
neuper@37906
    74
;
akargl@42145
    75
akargl@42145
    76
(*========== inhibit exn 110721 ================================================
neuper@37906
    77
val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
    78
atomty sc';
akargl@42145
    79
========== inhibit exn 110721 ================================================*)
akargl@42145
    80
akargl@42169
    81
val {scr = Script sc,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
neuper@37906
    82
(*---------------------------------------------------------------------
neuper@38031
    83
if sc = sc' then () else error"script.sml, doesnt find Substitute #1";
neuper@37906
    84
---------------------------------------------------------------------*)
neuper@37906
    85
neuper@37906
    86
val fmz = ["Traegerlaenge L",
neuper@37906
    87
	   "Streckenlast (- q_0 * x^^^2 / 2 + x * c + c_2)",
neuper@37906
    88
	   "Biegelinie y",
neuper@37906
    89
	   "RandbedingungenBiegung [y 0 = 0, y L = 0]",
neuper@37906
    90
	   "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
neuper@37906
    91
	   "FunktionsVariable x"];
akargl@42145
    92
neuper@37906
    93
val (dI',pI',mI') =
neuper@38058
    94
  ("Biegelinie",["MomentBestimmte","Biegelinien"],
neuper@37906
    95
   ["IntegrierenUndKonstanteBestimmen"]);
akargl@42145
    96
neuper@37906
    97
val p = e_pos'; val c = [];
akargl@42145
    98
neuper@37906
    99
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
akargl@42169
   100
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   101
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   102
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   103
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   104
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   105
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   106
val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42145
   107
neuper@37906
   108
case nxt of (_, Apply_Method ["IntegrierenUndKonstanteBestimmen"]) => ()
neuper@38031
   109
	  | _ => error "script.sml, doesnt find Substitute #2";
akargl@42169
   110
akargl@42169
   111
(*========== inhibit exn AK110721 ================================================
akargl@42169
   112
akargl@42169
   113
(* AK110722 f2str f is NOT working anywhere - deprecated?????*)
akargl@42169
   114
akargl@42169
   115
(*(* val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
akargl@42169
   116
  (* ERROR: exception PTREE "get_obj: pos = [0] does not exist" raised 
akargl@42169
   117
            (line 908 of "src/Tools/isac/Interpret/ctree.sml")*)*)
akargl@42169
   118
(*f2str f;
akargl@42169
   119
  (* ERROR: exception Match raised (line 416 of "src/Tools/isac/Interpret/mathengine.sml")*)*)
akargl@42169
   120
(* "~~~~~ fun f2str, args:"; val ((Form' (FormKF (_, _, _, _, cterm')))) = (f);
akargl@42169
   121
  (* ERROR: exception Bind raised *)*)
akargl@42169
   122
akargl@42169
   123
 f;
akargl@42169
   124
 f2str;*)
akargl@42169
   125
neuper@37906
   126
(* *** generate1: not impl.for Substitute' !!!!!!!!!!(*#1#*)!!!!!!!!!!!*)
neuper@37906
   127
(* val nxt = ("Check_Postcond",.. !!!!!!!!!!!!!!!!!!!(*#2#*)!!!!!!!!!!!*)
neuper@37906
   128
neuper@37906
   129
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   130
(* *** generate1: not impl.for Empty_Tac_  !!!!!!!!!!(*#3#*)!!!!!!!!!!!*)
neuper@37906
   131
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   132
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   133
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   134
(*---------------------------------------------------------------------*)
akargl@42145
   135
neuper@37906
   136
case nxt of (_, End_Proof') => () 
neuper@38031
   137
	  | _ => error "script.sml, doesnt find Substitute #3";
neuper@37906
   138
(*---------------------------------------------------------------------*)
neuper@37906
   139
(*the reason, that next_tac didnt find the 2nd Substitute, was that
neuper@37906
   140
  the Take inbetween was missing, and thus the 2nd Substitute was applied
neuper@37906
   141
  the last formula in ctree, and not to argument from script*)
akargl@42169
   142
========== inhibit exn AK110721 ================================================*)
neuper@37906
   143
neuper@37906
   144
neuper@37906
   145
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
   146
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
   147
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
   148
(*replace met 'IntegrierenUndKonstanteBestimmen' with this script...*)
neuper@37906
   149
val str = (*Substitute ; Substitute works*)
akargl@42169
   150
"Script BiegelinieScript                                             " ^
akargl@42169
   151
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^
akargl@42169
   152
"(rb_rb::bool list) (rm_rm::bool list) =                             "^
neuper@37906
   153
(*begin after the 2nd integrate*)
akargl@42169
   154
"  (let M__M = Take (M_b v_v = q__q);                                " ^
akargl@42169
   155
"       e1__e1 = nth_nth 1 rm_rm ;                                   " ^
akargl@42169
   156
"       (x1__x1::real) = argument_in (lhs e1__e1);                   " ^
akargl@42169
   157
"       (M1__M1::bool) = Substitute [v_v = x1__x1] M__M;             " ^
akargl@42169
   158
"        M1__M1        = Substitute [e1__e1] M1__M1                  " ^
akargl@42169
   159
" in True)"
neuper@37906
   160
;
akargl@42145
   161
(*========== inhibit exn 110721 ================================================
neuper@37906
   162
(*---^^^-OK-----------------------------------------------------------------*)
neuper@37906
   163
val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
   164
atomty sc';
neuper@37906
   165
(*---vvv-NOT ok-------------------------------------------------------------*)
akargl@42145
   166
========== inhibit exn 110721 ================================================*)
akargl@42145
   167
neuper@37906
   168
val str = (*Substitute @@ Substitute does NOT work???*)
akargl@42169
   169
"Script BiegelinieScript                                             " ^
akargl@42169
   170
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^
akargl@42169
   171
"(rb_rb::bool list) (rm_rm::bool list) =                             "^
neuper@37906
   172
(*begin after the 2nd integrate*)
akargl@42169
   173
"  (let M__M = Take (M_b v_v = q__q);                                " ^
akargl@42169
   174
"       e1__e1 = nth_nth 1 rm_rm ;                                   " ^
akargl@42169
   175
"       (x1__x1::real) = argument_in (lhs e1__e1);                   " ^
akargl@42169
   176
"       (M1__M1::bool) = ((Substitute [v_v = x1__x1]) @@             " ^
akargl@42169
   177
"                       (Substitute [e1__e1]))        M__M           " ^
akargl@42169
   178
" in True)"
neuper@37906
   179
;
neuper@37906
   180
akargl@42169
   181
val {scr = Script sc,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
neuper@37906
   182
(*---------------------------------------------------------------------
akargl@42169
   183
if sc = sc' then () else error "script.sml, doesnt find Substitute #1";
neuper@37906
   184
---------------------------------------------------------------------*)
neuper@37906
   185
val fmz = ["Traegerlaenge L",
neuper@37906
   186
	   "Streckenlast (- q_0 * x^^^2 / 2 + x * c + c_2)",
neuper@37906
   187
	   "Biegelinie y",
neuper@37906
   188
	   "RandbedingungenBiegung [y 0 = 0, y L = 0]",
neuper@37906
   189
	   "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
neuper@37906
   190
	   "FunktionsVariable x"];
neuper@37906
   191
val (dI',pI',mI') =
neuper@38058
   192
  ("Biegelinie",["MomentBestimmte","Biegelinien"],
neuper@37906
   193
   ["IntegrierenUndKonstanteBestimmen"]);
neuper@37906
   194
val p = e_pos'; val c = [];
neuper@37906
   195
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
akargl@42169
   196
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   197
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   198
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   199
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   200
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   201
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   202
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   203
case nxt of (_, Apply_Method ["IntegrierenUndKonstanteBestimmen"]) => ()
neuper@38031
   204
	  | _ => error "script.sml, doesnt find Substitute #2";
akargl@42145
   205
akargl@42169
   206
(*========== inhibit exn AK110721 ================================================
akargl@42169
   207
(* ERROR: caused by f2str f *)
neuper@37906
   208
trace_rewrite:=true;
neuper@37906
   209
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f(*------------------------*);
neuper@37906
   210
trace_rewrite:=false;
akargl@42169
   211
  (*Exception TYPE raised:
akargl@42169
   212
    Illegal type for constant "HOL.eq" :: "[real, bool] => bool"
akargl@42169
   213
    Atools.argument'_in (Tools.lhs (ListG.nth_ (1 + -1 + -1) [])) =
akargl@42169
   214
    ListG.nth_ (1 + -1 + -1) []
akargl@42169
   215
    Exception-
akargl@42169
   216
       TYPE
akargl@42169
   217
          ("Illegal type for constant \"op =\" :: \"[real, bool] => bool\"",
akargl@42169
   218
             [],
akargl@42169
   219
             [Const ("HOL.Trueprop", "bool => prop") $
akargl@42169
   220
                   (Const ("HOL.eq", "[RealDef.real, bool] => bool") $ ... $ ...)])
akargl@42169
   221
       raised
akargl@42169
   222
    ... this was because eval_argument_in took "argument_in (lhs (M_b 0 = 0))"
akargl@42169
   223
    ie. the argument had not been simplified before          ^^^^^^^^^^^^^^^
akargl@42169
   224
    thus corrected eval_argument_in OK*)
akargl@42169
   225
========== inhibit exn AK110721 ================================================*)
neuper@37906
   226
neuper@37906
   227
val {srls,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
akargl@42169
   228
val e1__e1 = str2term "nth_nth 1 [M_b 0 = 0, M_b L = 0]";
akargl@42169
   229
val e1__e1 = eval_listexpr_ @{theory Biegelinie} srls e1__e1; term2str e1__e1;
akargl@42169
   230
akargl@42145
   231
(*========== inhibit exn 110721 ================================================
akargl@42169
   232
(*AK110722
akargl@42169
   233
 TRIAL: Should be the same
akargl@42169
   234
 term2str e1__e1 = "M_b 0 = 0";
akargl@42169
   235
 term2str e1__e1;*)
akargl@42145
   236
akargl@42169
   237
if term2str e1__e1 = "M_b 0 = 0"
akargl@42169
   238
  then ()
akargl@42169
   239
  else error"script.sml diff.beh. eval_listexpr_ nth_nth 1 [...";
akargl@42145
   240
========== inhibit exn 110721 ================================================*)
neuper@37906
   241
neuper@37906
   242
(*TODO.WN050913 ??? doesnt eval_listexpr_ go into subterms ???...
akargl@42169
   243
 val x1__ = str2term"argument_in (lhs (M_b 0 = 0))";
akargl@42169
   244
 val x1__ = eval_listexpr_ Biegelinie.thy srls x1__; term2str x1__;
akargl@42169
   245
 (*no rewrite*)
akargl@42169
   246
 calculate_ Biegelinie.thy ("Tools.lhs", eval_rhs"eval_lhs_") x1__;
akargl@42169
   247
 val SOME (str, t) = eval_lhs 0 "Tools.lhs" (str2term"lhs (M_b 0 = 0)") 0;*)
neuper@37906
   248
akargl@42169
   249
val l__l = str2term "lhs (M_b 0 = 0)";
akargl@42169
   250
(*AK110722 eval_listexpr_ is prob. without _ ????*)
akargl@42169
   251
val l__l = eval_listexpr_ @{theory Biegelinie} srls l__l; term2str l__l;
akargl@42169
   252
val SOME (str, t) = eval_lhs 0 "Tools.lhs" (str2term "lhs (M_b 0 = 0)") 0;
akargl@42145
   253
(*========== inhibit exn 110721 ================================================
neuper@37906
   254
trace_rewrite:=true;
akargl@42169
   255
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f (*------------------------*);
neuper@37906
   256
trace_rewrite:=false;
akargl@42145
   257
========== inhibit exn 110721 ================================================*)
neuper@37906
   258
neuper@37906
   259
show_mets();
neuper@37906
   260
neuper@37906
   261
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@37906
   262
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@37906
   263
"----------- fun sel_appl_atomic_tacs ----------------------------";
akargl@42145
   264
neuper@37906
   265
states:=[];
neuper@41970
   266
CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   267
  ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   268
   ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   269
Iterator 1;
neuper@37906
   270
moveActiveRoot 1;
neuper@37906
   271
autoCalculate 1 CompleteCalcHead;
neuper@37906
   272
autoCalculate 1 (Step 1);
neuper@37906
   273
autoCalculate 1 (Step 1);
neuper@37906
   274
val ((pt, p), _) = get_calc 1; show_pt pt;
neuper@37906
   275
val appltacs = sel_appl_atomic_tacs pt p;
akargl@42145
   276
akargl@42169
   277
(*========== inhibit exn AK110721 ================================================
akargl@42169
   278
(*(*These SHOULD be the same*)
akargl@42145
   279
 print_depth(999);
akargl@42145
   280
 appltacs;
akargl@42145
   281
 [Rewrite ("radd_commute", "?m + ?n = ?n + ?m"),
akargl@42145
   282
    Rewrite ("radd_assoc", "?m + ?n + ?k = ?m + (?n + ?k)"),
akargl@42169
   283
    Calculate "TIMES"];*)
akargl@42145
   284
neuper@37906
   285
if appltacs = 
neuper@37906
   286
   [Rewrite ("radd_commute", "?m + ?n = ?n + ?m"),
neuper@37906
   287
    Rewrite ("radd_assoc", "?m + ?n + ?k = ?m + (?n + ?k)"),
akargl@42169
   288
    Calculate "TIMES"] then ()
neuper@38031
   289
else error "script.sml fun sel_appl_atomic_tacs diff.behav.";
akargl@42169
   290
========== inhibit exn AK110721 ================================================*)
neuper@37906
   291
neuper@37906
   292
trace_script := true;
neuper@37906
   293
trace_script := false;
neuper@37906
   294
applyTactic 1 p (hd appltacs);
neuper@37906
   295
val ((pt, p), _) = get_calc 1; show_pt pt;
neuper@37906
   296
val appltacs = sel_appl_atomic_tacs pt p;
neuper@37906
   297
akargl@42169
   298
(*(* AK110722 Debugging start*)
akargl@42169
   299
(*applyTactic 1 p (hd appltacs); WAS assy: call by ([3], Pbl)*)
akargl@42169
   300
"~~~~~ fun applyTactic, args:"; val ((cI:calcID), ip, tac) = (1, p, (hd appltacs));
akargl@42169
   301
val ((pt, _), _) = get_calc cI;
akargl@42169
   302
val p = get_pos cI 1;
akargl@42169
   303
akargl@42169
   304
locatetac;
akargl@42169
   305
locatetac tac;
akargl@42169
   306
locatetac tac;
akargl@42169
   307
akargl@42169
   308
(*locatetac tac (pt, ip); (*WAS assy: call by ([3], Pbl)*)*)
akargl@42169
   309
"~~~~~ fun locatetac, args:"; val (tac, (ptp as (pt, p))) = (tac, (pt, ip));
akargl@42169
   310
val (mI,m) = mk_tac'_ tac;
akargl@42169
   311
akargl@42169
   312
applicable_in p pt m ; (*Appl*)
akargl@42169
   313
akargl@42169
   314
member op = specsteps mI; (*false*)
akargl@42169
   315
akargl@42169
   316
(*loc_solve_ (mI,m) ptp; (*Argument: (mI, m) : string * tac Reason: Can't unify tac_ with tac*)*)
akargl@42169
   317
loc_solve_; (*without _ ??? result is -> lOc writing error ???*)
akargl@42169
   318
(*val it = fn: string * tac_ -> ptree * (pos * pos_) -> lOc_*)
akargl@42169
   319
(mI,m); (*string * tac*)
akargl@42169
   320
ptp (*ptree * pos'*);
akargl@42169
   321
akargl@42169
   322
"~~~~~ fun loc_solve_, args:"; val (m ,(pt,pos)) = ((mI,m), ptp);
akargl@42169
   323
(*val (msg, cs') = solve m (pt, pos);
akargl@42169
   324
(*Argument: m : string * tac Reason: Can't unify tac_ with tac (Different type constructors)*)*)
akargl@42169
   325
akargl@42169
   326
m;
akargl@42169
   327
(pt, pos);
akargl@42169
   328
akargl@42169
   329
"~~~~~ fun solve, args:"; val ((mI,m), (pt, po as (p,p_))) = (m, (pt, pos));
akargl@42169
   330
(*solve has still p_!!!!!!!!!!!!!!!!!!!!!!!!!*)
akargl@42169
   331
akargl@42169
   332
e_metID = get_obj g_metID pt (par_pblobj pt p); (*false*)
akargl@42169
   333
val ctxt = get_ctxt pt po;
akargl@42169
   334
akargl@42169
   335
(*generate1 (assoc_thy (get_obj g_domID pt (par_pblobj pt p))) m (e_istate, ctxt) (p,p_) pt;
akargl@42169
   336
(*Argument: m : tac Reason: Can't unify tac_ with tac (Different type constructors)*)*)
akargl@42169
   337
(assoc_thy (get_obj g_domID pt (par_pblobj pt p)));
akargl@42169
   338
assoc_thy;
akargl@42169
   339
akargl@42169
   340
(*not finished - error continues in fun generate1*)
akargl@42169
   341
(* AK110722 Debugging end*)*)
akargl@42169
   342
(*========== inhibit exn AK110721 ================================================
akargl@42169
   343
"----- WN080102 these vvv do not work, because locatetac starts the search" ^
akargl@42169
   344
 "1 stac too low";
akargl@42169
   345
(* AK110722 ERROR: assy: call by ([3], Pbl) *)
neuper@37906
   346
applyTactic 1 p (hd appltacs);
akargl@42169
   347
============ inhibit exn AK110721 ==============================================*)
akargl@42169
   348
neuper@37906
   349
autoCalculate 1 CompleteCalc;
neuper@37906
   350
neuper@41969
   351
"----------- fun init_form, fun get_stac -------------------------";
neuper@41969
   352
"----------- fun init_form, fun get_stac -------------------------";
neuper@41969
   353
"----------- fun init_form, fun get_stac -------------------------";
neuper@41969
   354
val fmz = ["equality (x+1=(2::real))", "solveFor x", "solutions L"];
neuper@41969
   355
val (dI',pI',mI') = ("Test",["sqroot-test","univariate","equation","test"],
neuper@41969
   356
  ["Test","squ-equ-test-subpbl1"]);
neuper@41969
   357
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@41969
   358
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   359
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   360
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   361
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   362
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   363
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   364
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   365
"~~~~~ fun me, args:"; val (_,tac) = nxt;
neuper@41969
   366
"~~~~~ fun locatetac, args:"; val ptp as (pt, p) = (pt, p);
neuper@41969
   367
val (mI,m) = mk_tac'_ tac;
neuper@41969
   368
val Appl m = applicable_in p pt m;
neuper@41969
   369
member op = specsteps mI; (*false*)
neuper@41969
   370
"~~~~~ fun loc_solve_, args:"; val (m, (pt, pos) ) = ((mI, m), ptp);
neuper@41969
   371
"~~~~~ fun solve, args:"; val (("Apply_Method", Apply_Method' (mI,_,_,_)), pos as (p,_)) = (m, pos);
neuper@41969
   372
val {srls, ...} = get_met mI;
neuper@41969
   373
val PblObj {meth=itms, ...} = get_obj I pt p;
neuper@41969
   374
val thy' = get_obj g_domID pt p;
neuper@41969
   375
val thy = assoc_thy thy';
neuper@41969
   376
val (is as ScrState (env,_,_,_,_,_), ctxt, sc) = init_scrstate thy itms mI;
neuper@41969
   377
val ini = init_form thy sc env;
neuper@41969
   378
"----- fun init_form, args:"; val (Script sc) = sc;
neuper@41969
   379
"----- fun get_stac, args:"; val (y, h $ body) = (thy, sc);
neuper@41969
   380
case get_stac thy sc of SOME (Free ("e_e", _)) => ()
neuper@41969
   381
| _ => error "script: Const (?, ?) in script (as term) changed";;
neuper@41969
   382
neuper@41972
   383
neuper@41972
   384
"----------- x+1=2 start SubProblem 'stac2tac_ TODO: no match for ";
neuper@41972
   385
"----------- x+1=2 start SubProblem 'stac2tac_ TODO: no match for ";
neuper@41972
   386
"----------- x+1=2 start SubProblem 'stac2tac_ TODO: no match for ";
neuper@41972
   387
val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
neuper@41972
   388
val (dI',pI',mI') =
neuper@41972
   389
  ("Test", ["sqroot-test","univariate","equation","test"],
neuper@41972
   390
   ["Test","squ-equ-test-subpbl1"]);
neuper@41972
   391
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@41972
   392
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   393
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   394
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   395
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   396
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   397
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   398
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   399
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   400
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   401
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt; WAS: Empty_Tac, helpless*)
neuper@41972
   402
show_pt pt;
neuper@41972
   403
"~~~~~ fun me, args:"; val (_,tac) = nxt;
neuper@41973
   404
val (pt, p) = case locatetac tac (pt,p) of
neuper@41973
   405
	("ok", (_, _, ptp))  => ptp | _ => error "script.sml locatetac";
neuper@41972
   406
"~~~~~ fun step, args:"; val (ip as (_,p_), (ptp as (pt,p), tacis)) = (p, ((pt, e_pos'), []))
neuper@41999
   407
val pIopt = get_pblID (pt,ip); (*SOME ["linear", "univariate", "equation", "test"]*)
neuper@41972
   408
tacis; (*= []*)
neuper@41972
   409
member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p)); (*= false*)
neuper@41972
   410
"~~~~~ fun nxt_solve_, args:"; val (ptp as (pt, pos as (p, p_))) = (pt, ip);
neuper@41972
   411
                                 (*WAS stac2tac_ TODO: no match for SubProblem*)
neuper@41972
   412
val thy' = get_obj g_domID pt (par_pblobj pt p);
neuper@41972
   413
val (srls, is, sc) = from_pblobj_or_detail' thy' (p,p_) pt;
neuper@41972
   414
"~~~~~ fun next_tac, args:"; val (thy, (ptp as (pt,(p,_)):ptree * pos'), (sc as Script (h $ body)), 
neuper@41972
   415
	                               (ScrState (E,l,a,v,s,b), ctxt)) = ((thy',srls), (pt,pos), sc, is);
neuper@41972
   416
l; (*= [R, L, R, L, R, R]*)
neuper@41972
   417
val Appy (m', scrst as (_,_,_,v,_,_)) = nstep_up thy ptp sc E l Skip_ a v;
neuper@41972
   418
"~~~~~ dont like to go into nstep_up...";
neuper@41972
   419
val t = str2term ("SubProblem" ^ 
neuper@41972
   420
  "(Test', [linear, univariate, equation, test], [Test, solve_linear])" ^
neuper@41972
   421
  "[BOOL (-1 + x = 0), REAL x]");
neuper@41972
   422
val (tac, tac_) = stac2tac_ pt @{theory "Isac"} t; (*WAS stac2tac_ TODO: no match for SubProblem*)
neuper@41972
   423
case tac_ of 
neuper@41972
   424
  Subproblem' _ => ()
neuper@41972
   425
| _ => error "script.sml x+1=2 start SubProblem from script";
neuper@41972
   426
neuper@41972
   427
neuper@41982
   428
"----------- x+1=2 set ctxt in Subproblem ------------------------";
neuper@41982
   429
"----------- x+1=2 set ctxt in Subproblem ------------------------";
neuper@41982
   430
"----------- x+1=2 set ctxt in Subproblem ------------------------";