test/Tools/isac/Interpret/script.sml
author Walther Neuper <neuper@ist.tugraz.at>
Sat, 17 Mar 2012 11:06:46 +0100
changeset 42394 977788dfed26
parent 42387 767debe8a50c
child 42438 31e1aa39b5cb
permissions -rw-r--r--
uncomment test/../rateq.sml (Isabelle 2002 --> 2011)

WN120317.TODO dropped rateq:
# test --- repair NO asms from rls RatEq_eliminate --- shows error from 2002
# test --- solve (1/x = 5, x) by me --- and --- x / (x ^ 2 - 6 * x + 9) - ...:
investigation Check_elementwise stopped due to too much effort finding out,
why Check_elementwise worked in 2002 in spite of the error.
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@42283
    13
"----------- Take as 1st stac in script --------------------------";
neuper@42394
    14
"----------- 'trace_script' from outside 'fun me '----------------";
neuper@37906
    15
"-----------------------------------------------------------------";
neuper@37906
    16
"-----------------------------------------------------------------";
neuper@37906
    17
"-----------------------------------------------------------------";
neuper@37906
    18
t@42214
    19
val thy= @{theory Isac};
neuper@42281
    20
neuper@37906
    21
"----------- WN0509 why does next_tac doesnt find Substitute -----";
neuper@37906
    22
"----------- WN0509 why does next_tac doesnt find Substitute -----";
neuper@37906
    23
"----------- WN0509 why does next_tac doesnt find Substitute -----";
neuper@37906
    24
neuper@37906
    25
(*replace met 'IntegrierenUndKonstanteBestimmen' with this script...*)
neuper@37906
    26
val str = (*#1#*)
akargl@42169
    27
"Script BiegelinieScript                                             " ^ 
akargl@42169
    28
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^ 
akargl@42169
    29
"(rb_rb::bool list) (rm_rm::bool list) =                             " ^
akargl@42169
    30
"  (let q___q = Take (M_b v_v = q__q);                               " ^
akargl@42169
    31
"       (M1__M1::bool) = ((Substitute [v_v = 0])) q___q              " ^
akargl@42169
    32
" in True)";
akargl@42169
    33
neuper@37906
    34
val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
    35
neuper@37906
    36
val str = (*#2#*)
akargl@42169
    37
"Script BiegelinieScript                                             " ^ 
akargl@42169
    38
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^ 
akargl@42169
    39
"(rb_rb::bool list) (rm_rm::bool list) =                             " ^ 
akargl@42169
    40
"       (M1__M1::bool) = ((Substitute [v_v = 0]) @@                  " ^
akargl@42169
    41
" in True)";(*..doesnt find Substitute with ..@@ !!!!!!!!!!!!!!!!!!!!!*)
neuper@37906
    42
neuper@37906
    43
val str = (*#3#*)
akargl@42169
    44
"Script BiegelinieScript                                             " ^
akargl@42169
    45
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^
akargl@42169
    46
"(rb_rb::bool list) (rm_rm::bool list) =                             " ^
akargl@42169
    47
"  (let q___q = Take (q_q v_v = q__q);                               " ^
akargl@42169
    48
"      (M1__M1::bool) = Substitute [v_v = 0]      q___q ;            " ^
akargl@42169
    49
"       M1__m1 =        Substitute [M_b 0 = 0]  M1__M1               " ^
akargl@42169
    50
" in True)"
neuper@37906
    51
;
neuper@37906
    52
val str = (*#4#*)
akargl@42169
    53
"Script BiegelinieScript                                             " ^
akargl@42169
    54
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^
akargl@42169
    55
"(rb_rb::bool list) (rm_rm::bool list) =                             " ^
akargl@42169
    56
"  (let q___q = Take (q_q v_v = q__q);                               " ^
akargl@42169
    57
"      (M1__M1::bool) = Substitute [v_v = 0]      q___q ;            " ^
akargl@42169
    58
"       M1__M1 =        Substitute [v_v = 1]      q___q ;            " ^
akargl@42169
    59
"       M1__M1 =        Substitute [v_v = 2]      q___q ;            " ^
akargl@42169
    60
"       M1__M1 =        Substitute [v_v = 3]      q___q ;            " ^
akargl@42169
    61
"       M1__M1 =        Substitute [M_b 0 = 0]  M1__M1               " ^
akargl@42169
    62
" in True)"
neuper@37906
    63
;
neuper@37906
    64
val str = (*#5#*)
akargl@42169
    65
"Script BiegelinieScript                                             " ^
akargl@42169
    66
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^
akargl@42169
    67
"(rb_rb::bool list) (rm_rm::bool list) =                             " ^
akargl@42169
    68
"  (let q___q = Take (M_b v_v = q__q);                               " ^
akargl@42169
    69
"      (M1__M1::bool) = Substitute [v_v = 0]      q___q ;            " ^
akargl@42169
    70
"       M2__M2 = Take q___q ;                                        " ^
akargl@42169
    71
"       M2__M2 =        Substitute [v_v = 2]      q___q              " ^
akargl@42169
    72
" in True)"
neuper@37906
    73
;
akargl@42145
    74
neuper@37906
    75
val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
    76
atomty sc';
akargl@42145
    77
akargl@42169
    78
val {scr = Script sc,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
neuper@37906
    79
(*---------------------------------------------------------------------
neuper@38031
    80
if sc = sc' then () else error"script.sml, doesnt find Substitute #1";
neuper@37906
    81
---------------------------------------------------------------------*)
neuper@37906
    82
neuper@37906
    83
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
    84
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
    85
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
    86
(*replace met 'IntegrierenUndKonstanteBestimmen' with this script...*)
neuper@37906
    87
val str = (*Substitute ; Substitute works*)
akargl@42169
    88
"Script BiegelinieScript                                             " ^
akargl@42169
    89
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^
akargl@42169
    90
"(rb_rb::bool list) (rm_rm::bool list) =                             "^
neuper@37906
    91
(*begin after the 2nd integrate*)
akargl@42169
    92
"  (let M__M = Take (M_b v_v = q__q);                                " ^
akargl@42169
    93
"       e1__e1 = nth_nth 1 rm_rm ;                                   " ^
akargl@42169
    94
"       (x1__x1::real) = argument_in (lhs e1__e1);                   " ^
akargl@42169
    95
"       (M1__M1::bool) = Substitute [v_v = x1__x1] M__M;             " ^
akargl@42169
    96
"        M1__M1        = Substitute [e1__e1] M1__M1                  " ^
akargl@42169
    97
" in True)"
neuper@37906
    98
;
neuper@37906
    99
val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
   100
atomty sc';
akargl@42145
   101
neuper@37906
   102
val str = (*Substitute @@ Substitute does NOT work???*)
akargl@42169
   103
"Script BiegelinieScript                                             " ^
akargl@42169
   104
"(l_l::real) (q__q::real) (v_v::real) (b_b::real=>real)              " ^
akargl@42169
   105
"(rb_rb::bool list) (rm_rm::bool list) =                             "^
neuper@37906
   106
(*begin after the 2nd integrate*)
akargl@42169
   107
"  (let M__M = Take (M_b v_v = q__q);                                " ^
akargl@42169
   108
"       e1__e1 = nth_nth 1 rm_rm ;                                   " ^
akargl@42169
   109
"       (x1__x1::real) = argument_in (lhs e1__e1);                   " ^
akargl@42169
   110
"       (M1__M1::bool) = ((Substitute [v_v = x1__x1]) @@             " ^
akargl@42169
   111
"                       (Substitute [e1__e1]))        M__M           " ^
akargl@42169
   112
" in True)"
neuper@37906
   113
;
neuper@37906
   114
akargl@42169
   115
val {scr = Script sc,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
neuper@37906
   116
(*---------------------------------------------------------------------
akargl@42169
   117
if sc = sc' then () else error "script.sml, doesnt find Substitute #1";
neuper@37906
   118
---------------------------------------------------------------------*)
neuper@37906
   119
val fmz = ["Traegerlaenge L",
neuper@37906
   120
	   "Streckenlast (- q_0 * x^^^2 / 2 + x * c + c_2)",
neuper@37906
   121
	   "Biegelinie y",
neuper@37906
   122
	   "RandbedingungenBiegung [y 0 = 0, y L = 0]",
neuper@37906
   123
	   "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
neuper@37906
   124
	   "FunktionsVariable x"];
neuper@37906
   125
val (dI',pI',mI') =
neuper@38058
   126
  ("Biegelinie",["MomentBestimmte","Biegelinien"],
neuper@37906
   127
   ["IntegrierenUndKonstanteBestimmen"]);
neuper@37906
   128
val p = e_pos'; val c = [];
neuper@37906
   129
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
akargl@42169
   130
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   131
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   132
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   133
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
akargl@42169
   134
val (p,_,f,nxt,_,pt) = me nxt p c pt; val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   135
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   136
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   137
case nxt of (_, Apply_Method ["IntegrierenUndKonstanteBestimmen"]) => ()
neuper@38031
   138
	  | _ => error "script.sml, doesnt find Substitute #2";
akargl@42169
   139
(* ERROR: caused by f2str f *)
neuper@37906
   140
trace_rewrite:=true;
neuper@42387
   141
neuper@37906
   142
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f(*------------------------*);
neuper@37906
   143
trace_rewrite:=false;
akargl@42169
   144
  (*Exception TYPE raised:
akargl@42169
   145
    Illegal type for constant "HOL.eq" :: "[real, bool] => bool"
akargl@42169
   146
    Atools.argument'_in (Tools.lhs (ListG.nth_ (1 + -1 + -1) [])) =
akargl@42169
   147
    ListG.nth_ (1 + -1 + -1) []
akargl@42169
   148
    Exception-
akargl@42169
   149
       TYPE
akargl@42169
   150
          ("Illegal type for constant \"op =\" :: \"[real, bool] => bool\"",
akargl@42169
   151
             [],
akargl@42169
   152
             [Const ("HOL.Trueprop", "bool => prop") $
akargl@42169
   153
                   (Const ("HOL.eq", "[RealDef.real, bool] => bool") $ ... $ ...)])
akargl@42169
   154
       raised
akargl@42169
   155
    ... this was because eval_argument_in took "argument_in (lhs (M_b 0 = 0))"
akargl@42169
   156
    ie. the argument had not been simplified before          ^^^^^^^^^^^^^^^
akargl@42169
   157
    thus corrected eval_argument_in OK*)
neuper@37906
   158
val {srls,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
neuper@42387
   159
val e1__e1 = str2term "NTH 1 [M_b 0 = 0, M_b L = 0]";
akargl@42169
   160
val e1__e1 = eval_listexpr_ @{theory Biegelinie} srls e1__e1; term2str e1__e1;
akargl@42169
   161
if term2str e1__e1 = "M_b 0 = 0"
akargl@42169
   162
  then ()
akargl@42169
   163
  else error"script.sml diff.beh. eval_listexpr_ nth_nth 1 [...";
neuper@37906
   164
neuper@37906
   165
(*TODO.WN050913 ??? doesnt eval_listexpr_ go into subterms ???...
akargl@42169
   166
 val x1__ = str2term"argument_in (lhs (M_b 0 = 0))";
akargl@42169
   167
 val x1__ = eval_listexpr_ Biegelinie.thy srls x1__; term2str x1__;
akargl@42169
   168
 (*no rewrite*)
akargl@42169
   169
 calculate_ Biegelinie.thy ("Tools.lhs", eval_rhs"eval_lhs_") x1__;
akargl@42169
   170
 val SOME (str, t) = eval_lhs 0 "Tools.lhs" (str2term"lhs (M_b 0 = 0)") 0;*)
neuper@37906
   171
akargl@42169
   172
val l__l = str2term "lhs (M_b 0 = 0)";
akargl@42169
   173
val l__l = eval_listexpr_ @{theory Biegelinie} srls l__l; term2str l__l;
akargl@42169
   174
val SOME (str, t) = eval_lhs 0 "Tools.lhs" (str2term "lhs (M_b 0 = 0)") 0;
neuper@42387
   175
akargl@42169
   176
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f (*------------------------*);
neuper@42387
   177
if nxt = ("Rewrite", Rewrite ("Belastung_Querkraft", "Biegelinie.Belastung_Querkraft"))
neuper@42387
   178
then () else error "";
neuper@37906
   179
neuper@37906
   180
neuper@37906
   181
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@37906
   182
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@37906
   183
"----------- fun sel_appl_atomic_tacs ----------------------------";
akargl@42145
   184
neuper@37906
   185
states:=[];
neuper@41970
   186
CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   187
  ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   188
   ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   189
Iterator 1;
neuper@37906
   190
moveActiveRoot 1;
neuper@37906
   191
autoCalculate 1 CompleteCalcHead;
neuper@37906
   192
autoCalculate 1 (Step 1);
neuper@37906
   193
autoCalculate 1 (Step 1);
neuper@37906
   194
val ((pt, p), _) = get_calc 1; show_pt pt;
neuper@37906
   195
val appltacs = sel_appl_atomic_tacs pt p;
akargl@42145
   196
akargl@42169
   197
(*========== inhibit exn AK110721 ================================================
akargl@42169
   198
(*(*These SHOULD be the same*)
akargl@42145
   199
 print_depth(999);
akargl@42145
   200
 appltacs;
akargl@42145
   201
 [Rewrite ("radd_commute", "?m + ?n = ?n + ?m"),
akargl@42145
   202
    Rewrite ("radd_assoc", "?m + ?n + ?k = ?m + (?n + ?k)"),
akargl@42169
   203
    Calculate "TIMES"];*)
akargl@42145
   204
neuper@37906
   205
if appltacs = 
neuper@37906
   206
   [Rewrite ("radd_commute", "?m + ?n = ?n + ?m"),
neuper@37906
   207
    Rewrite ("radd_assoc", "?m + ?n + ?k = ?m + (?n + ?k)"),
akargl@42169
   208
    Calculate "TIMES"] then ()
neuper@38031
   209
else error "script.sml fun sel_appl_atomic_tacs diff.behav.";
akargl@42169
   210
========== inhibit exn AK110721 ================================================*)
neuper@37906
   211
neuper@37906
   212
trace_script := true;
neuper@37906
   213
trace_script := false;
neuper@37906
   214
applyTactic 1 p (hd appltacs);
neuper@37906
   215
val ((pt, p), _) = get_calc 1; show_pt pt;
neuper@37906
   216
val appltacs = sel_appl_atomic_tacs pt p;
neuper@37906
   217
akargl@42169
   218
(*(* AK110722 Debugging start*)
akargl@42169
   219
(*applyTactic 1 p (hd appltacs); WAS assy: call by ([3], Pbl)*)
akargl@42169
   220
"~~~~~ fun applyTactic, args:"; val ((cI:calcID), ip, tac) = (1, p, (hd appltacs));
akargl@42169
   221
val ((pt, _), _) = get_calc cI;
akargl@42169
   222
val p = get_pos cI 1;
akargl@42169
   223
akargl@42169
   224
locatetac;
akargl@42169
   225
locatetac tac;
akargl@42169
   226
locatetac tac;
akargl@42169
   227
akargl@42169
   228
(*locatetac tac (pt, ip); (*WAS assy: call by ([3], Pbl)*)*)
akargl@42169
   229
"~~~~~ fun locatetac, args:"; val (tac, (ptp as (pt, p))) = (tac, (pt, ip));
akargl@42169
   230
val (mI,m) = mk_tac'_ tac;
akargl@42169
   231
akargl@42169
   232
applicable_in p pt m ; (*Appl*)
akargl@42169
   233
akargl@42169
   234
member op = specsteps mI; (*false*)
akargl@42169
   235
akargl@42169
   236
(*loc_solve_ (mI,m) ptp; (*Argument: (mI, m) : string * tac Reason: Can't unify tac_ with tac*)*)
akargl@42169
   237
loc_solve_; (*without _ ??? result is -> lOc writing error ???*)
akargl@42169
   238
(*val it = fn: string * tac_ -> ptree * (pos * pos_) -> lOc_*)
akargl@42169
   239
(mI,m); (*string * tac*)
akargl@42169
   240
ptp (*ptree * pos'*);
akargl@42169
   241
akargl@42169
   242
"~~~~~ fun loc_solve_, args:"; val (m ,(pt,pos)) = ((mI,m), ptp);
akargl@42169
   243
(*val (msg, cs') = solve m (pt, pos);
akargl@42169
   244
(*Argument: m : string * tac Reason: Can't unify tac_ with tac (Different type constructors)*)*)
akargl@42169
   245
akargl@42169
   246
m;
akargl@42169
   247
(pt, pos);
akargl@42169
   248
akargl@42169
   249
"~~~~~ fun solve, args:"; val ((mI,m), (pt, po as (p,p_))) = (m, (pt, pos));
akargl@42169
   250
(*solve has still p_!!!!!!!!!!!!!!!!!!!!!!!!!*)
akargl@42169
   251
akargl@42169
   252
e_metID = get_obj g_metID pt (par_pblobj pt p); (*false*)
akargl@42169
   253
val ctxt = get_ctxt pt po;
akargl@42169
   254
akargl@42169
   255
(*generate1 (assoc_thy (get_obj g_domID pt (par_pblobj pt p))) m (e_istate, ctxt) (p,p_) pt;
akargl@42169
   256
(*Argument: m : tac Reason: Can't unify tac_ with tac (Different type constructors)*)*)
akargl@42169
   257
(assoc_thy (get_obj g_domID pt (par_pblobj pt p)));
akargl@42169
   258
assoc_thy;
akargl@42169
   259
akargl@42169
   260
(*not finished - error continues in fun generate1*)
akargl@42169
   261
(* AK110722 Debugging end*)*)
akargl@42169
   262
(*========== inhibit exn AK110721 ================================================
akargl@42169
   263
"----- WN080102 these vvv do not work, because locatetac starts the search" ^
akargl@42169
   264
 "1 stac too low";
akargl@42169
   265
(* AK110722 ERROR: assy: call by ([3], Pbl) *)
neuper@37906
   266
applyTactic 1 p (hd appltacs);
akargl@42169
   267
============ inhibit exn AK110721 ==============================================*)
akargl@42169
   268
neuper@37906
   269
autoCalculate 1 CompleteCalc;
neuper@37906
   270
neuper@41969
   271
"----------- fun init_form, fun get_stac -------------------------";
neuper@41969
   272
"----------- fun init_form, fun get_stac -------------------------";
neuper@41969
   273
"----------- fun init_form, fun get_stac -------------------------";
neuper@41969
   274
val fmz = ["equality (x+1=(2::real))", "solveFor x", "solutions L"];
neuper@41969
   275
val (dI',pI',mI') = ("Test",["sqroot-test","univariate","equation","test"],
neuper@41969
   276
  ["Test","squ-equ-test-subpbl1"]);
neuper@41969
   277
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@41969
   278
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   279
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   280
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   281
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   282
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   283
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   284
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   285
"~~~~~ fun me, args:"; val (_,tac) = nxt;
neuper@41969
   286
"~~~~~ fun locatetac, args:"; val ptp as (pt, p) = (pt, p);
neuper@41969
   287
val (mI,m) = mk_tac'_ tac;
neuper@41969
   288
val Appl m = applicable_in p pt m;
neuper@41969
   289
member op = specsteps mI; (*false*)
neuper@41969
   290
"~~~~~ fun loc_solve_, args:"; val (m, (pt, pos) ) = ((mI, m), ptp);
neuper@41969
   291
"~~~~~ fun solve, args:"; val (("Apply_Method", Apply_Method' (mI,_,_,_)), pos as (p,_)) = (m, pos);
neuper@41969
   292
val {srls, ...} = get_met mI;
neuper@41969
   293
val PblObj {meth=itms, ...} = get_obj I pt p;
neuper@41969
   294
val thy' = get_obj g_domID pt p;
neuper@41969
   295
val thy = assoc_thy thy';
neuper@41969
   296
val (is as ScrState (env,_,_,_,_,_), ctxt, sc) = init_scrstate thy itms mI;
neuper@41969
   297
val ini = init_form thy sc env;
neuper@41969
   298
"----- fun init_form, args:"; val (Script sc) = sc;
neuper@41969
   299
"----- fun get_stac, args:"; val (y, h $ body) = (thy, sc);
neuper@41969
   300
case get_stac thy sc of SOME (Free ("e_e", _)) => ()
neuper@41969
   301
| _ => error "script: Const (?, ?) in script (as term) changed";;
neuper@41969
   302
neuper@41972
   303
neuper@41972
   304
"----------- x+1=2 start SubProblem 'stac2tac_ TODO: no match for ";
neuper@41972
   305
"----------- x+1=2 start SubProblem 'stac2tac_ TODO: no match for ";
neuper@41972
   306
"----------- x+1=2 start SubProblem 'stac2tac_ TODO: no match for ";
neuper@41972
   307
val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
neuper@41972
   308
val (dI',pI',mI') =
neuper@41972
   309
  ("Test", ["sqroot-test","univariate","equation","test"],
neuper@41972
   310
   ["Test","squ-equ-test-subpbl1"]);
neuper@41972
   311
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@41972
   312
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   313
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   314
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   315
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   316
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   317
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   318
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   319
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   320
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41972
   321
(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt; WAS: Empty_Tac, helpless*)
neuper@41972
   322
show_pt pt;
neuper@41972
   323
"~~~~~ fun me, args:"; val (_,tac) = nxt;
neuper@41973
   324
val (pt, p) = case locatetac tac (pt,p) of
neuper@41973
   325
	("ok", (_, _, ptp))  => ptp | _ => error "script.sml locatetac";
neuper@41972
   326
"~~~~~ fun step, args:"; val (ip as (_,p_), (ptp as (pt,p), tacis)) = (p, ((pt, e_pos'), []))
neuper@41999
   327
val pIopt = get_pblID (pt,ip); (*SOME ["linear", "univariate", "equation", "test"]*)
neuper@41972
   328
tacis; (*= []*)
neuper@41972
   329
member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p)); (*= false*)
neuper@41972
   330
"~~~~~ fun nxt_solve_, args:"; val (ptp as (pt, pos as (p, p_))) = (pt, ip);
neuper@41972
   331
                                 (*WAS stac2tac_ TODO: no match for SubProblem*)
neuper@41972
   332
val thy' = get_obj g_domID pt (par_pblobj pt p);
neuper@41972
   333
val (srls, is, sc) = from_pblobj_or_detail' thy' (p,p_) pt;
neuper@41972
   334
"~~~~~ fun next_tac, args:"; val (thy, (ptp as (pt,(p,_)):ptree * pos'), (sc as Script (h $ body)), 
neuper@41972
   335
	                               (ScrState (E,l,a,v,s,b), ctxt)) = ((thy',srls), (pt,pos), sc, is);
neuper@41972
   336
l; (*= [R, L, R, L, R, R]*)
neuper@41972
   337
val Appy (m', scrst as (_,_,_,v,_,_)) = nstep_up thy ptp sc E l Skip_ a v;
neuper@41972
   338
"~~~~~ dont like to go into nstep_up...";
neuper@41972
   339
val t = str2term ("SubProblem" ^ 
neuper@41972
   340
  "(Test', [linear, univariate, equation, test], [Test, solve_linear])" ^
neuper@41972
   341
  "[BOOL (-1 + x = 0), REAL x]");
neuper@41972
   342
val (tac, tac_) = stac2tac_ pt @{theory "Isac"} t; (*WAS stac2tac_ TODO: no match for SubProblem*)
neuper@41972
   343
case tac_ of 
neuper@41972
   344
  Subproblem' _ => ()
neuper@41972
   345
| _ => error "script.sml x+1=2 start SubProblem from script";
neuper@41972
   346
neuper@41972
   347
neuper@42283
   348
"----------- Take as 1st stac in script --------------------------";
neuper@42283
   349
"----------- Take as 1st stac in script --------------------------";
neuper@42283
   350
"----------- Take as 1st stac in script --------------------------";
neuper@42283
   351
val p = e_pos'; val c = []; 
neuper@42283
   352
val (p,_,f,nxt,_,pt) = 
neuper@42283
   353
    CalcTreeTEST 
neuper@42283
   354
        [(["functionTerm (x^^^2 + 1)", "integrateBy x", "antiDerivative FF"],
neuper@42283
   355
          ("Integrate", ["integrate","function"], ["diff","integration"]))];
neuper@42283
   356
val (p,_,f,nxt,_,pt) = me nxt p c pt; (*nxt = ("Tac ", ...) --> Add_Given...*)
neuper@42283
   357
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@42283
   358
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@42283
   359
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@42283
   360
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@42283
   361
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@42283
   362
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@42283
   363
case nxt of (_, Apply_Method ["diff", "integration"]) => ()
neuper@42283
   364
          | _ => error "integrate.sml -- me method [diff,integration] -- spec";
neuper@42283
   365
"----- step 8: returns nxt = Rewrite_Set_Inst ([\"(bdv, x)\"],\"integration\")";
neuper@42283
   366
neuper@42283
   367
"~~~~~ fun me, args:"; val (((_,tac):tac'_), (p:pos'), _, (pt:ptree)) = (nxt, p, c, pt);
neuper@42283
   368
"~~~~~ fun locatetac, args:"; val (tac, (ptp as (pt, p))) = (tac, (pt,p));
neuper@42283
   369
val (mI,m) = mk_tac'_ tac;
neuper@42283
   370
val Appl m = applicable_in p pt m;
neuper@42283
   371
member op = specsteps mI (*false*);
neuper@42283
   372
"~~~~~ fun loc_solve_, args:"; val (m, (pt,pos)) = ((mI,m), ptp);
neuper@42283
   373
"~~~~~ fun solve, args:"; val ((_, m as Apply_Method' (mI, _, _, _)), (pt, (pos as (p,_)))) = 
neuper@42283
   374
                            (m, (pt, pos));
neuper@42283
   375
val {srls, ...} = get_met mI;
neuper@42283
   376
        val PblObj {meth=itms, ...} = get_obj I pt p;
neuper@42283
   377
        val thy' = get_obj g_domID pt p;
neuper@42283
   378
        val thy = assoc_thy thy';
neuper@42283
   379
        val (is as ScrState (env,_,_,_,_,_), ctxt, sc) = init_scrstate thy itms mI;
neuper@42283
   380
        val ini = init_form thy sc env;
neuper@42283
   381
        val p = lev_dn p;
neuper@42283
   382
ini = NONE; (*true*)
neuper@42283
   383
            val (m', (is', ctxt'), _) = next_tac (thy', srls) (pt, (p, Res)) sc (is, ctxt);
neuper@42283
   384
	            val d = e_rls (*FIXME: get simplifier from domID*);
neuper@42283
   385
"~~~~~ fun locate_gen, args:"; val ((ts as (thy',srls)), (m:tac_), ((pt,p):ptree * pos'), 
neuper@42283
   386
	                     (scr as Script (h $ body),d), (ScrState (E,l,a,v,S,b), ctxt)) = 
neuper@42283
   387
                   ((thy',srls), m', (pt,(p, Res)), (sc,d), (is', ctxt'));
neuper@42283
   388
val thy = assoc_thy thy';
neuper@42283
   389
l = [] orelse ((*init.in solve..Apply_Method...*)
neuper@42283
   390
			         (last_elem o fst) p = 0 andalso snd p = Res); (*true*)
neuper@42283
   391
"~~~~~ fun assy, args:"; val (ya, (is as (E,l,a,v,S,b),ss), 
neuper@42283
   392
                   (Const ("HOL.Let",_) $ e $ (Abs (id,T,body)))) = 
neuper@42283
   393
                 ((thy',ctxt,srls,d,Aundef), ((E,[R],a,v,S,b), [(m,EmptyMout,pt,p,[])]), body);
neuper@42283
   394
 (*check: true*) term2str e = "Take (Integral f_f D v_v)";
neuper@42283
   395
"~~~~~ fun assy, args:"; val ((thy',ctxt,sr,d,ap), (is as (E,l,a,v,S,b), (m,_,pt,(p,p_),c)::ss), t) = 
neuper@42283
   396
                           (ya, ((E , l@[L,R], a,v,S,b),ss), e);
neuper@42283
   397
val (a', STac stac) = handle_leaf "locate" thy' sr E a v t;
neuper@42283
   398
(*             val ctxt = get_ctxt pt (p,p_)
neuper@42283
   399
exception PTREE "get_obj: pos = [0] does not exist" raised 
neuper@42283
   400
(line 908 of "/usr/local/isabisac/src/Tools/isac/Interpret/ctree.sml")*)
neuper@42283
   401
neuper@42283
   402
neuper@42394
   403
"----------- 'trace_script' from outside 'fun me '----------------";
neuper@42394
   404
"----------- 'trace_script' from outside 'fun me '----------------";
neuper@42394
   405
"----------- 'trace_script' from outside 'fun me '----------------";
neuper@42394
   406
val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
neuper@42394
   407
val (dI',pI',mI') =
neuper@42394
   408
   ("Test", ["sqroot-test","univariate","equation","test"],
neuper@42394
   409
    ["Test","squ-equ-test-subpbl1"]);
neuper@42394
   410
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@42394
   411
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42394
   412
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42394
   413
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42394
   414
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42394
   415
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42394
   416
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@42394
   417
val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*nxt = Apply_Method ["Test", "squ-equ-test-subpbl1"]*)
neuper@42394
   418
(*from_pblobj_or_detail': no istate = from_pblobj_or_detail' "Isac" p pt;*)
neuper@42394
   419
neuper@42394
   420
val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*---------------------------------------------------*)
neuper@42394
   421
val (p'''', pt'''') = (p, pt);
neuper@42394
   422
f2str f = "x + 1 = 2";          snd nxt = Rewrite_Set "norm_equation";
neuper@42394
   423
val (p, p_) = p(* = ([1], Frm)*);
neuper@42394
   424
val (srls, (ScrState scrstate, ctxt), Script sc) = from_pblobj_or_detail' "Isac" (p, p_) pt;
neuper@42394
   425
val (env, loc_, curry_arg, res, Safe, true) = scrstate;
neuper@42394
   426
  env2str env = "[\"\n(e_e, x + 1 = 2)\",\"\n(v_v, x)\"]";
neuper@42394
   427
  loc_ = [];
neuper@42394
   428
  curry_arg = NONE;
neuper@42394
   429
  term2str res = "??.empty";                     (* scrstate before starting interpretation *)
neuper@42394
   430
(*term2str (go loc_ sc) = "Script Solve_root_equation e_e v_v = ...*)
neuper@42394
   431
neuper@42394
   432
val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*-------------------------------------------*)
neuper@42394
   433
val (p'''', pt'''') = (p, pt);
neuper@42394
   434
f2str f = "x + 1 + -1 * 2 = 0"; snd nxt = Rewrite_Set "Test_simplify";
neuper@42394
   435
val (p, p_) = p(* = ([1], Res)*);
neuper@42394
   436
val (srls, (ScrState scrstate, ctxt), Script sc) = from_pblobj_or_detail' "Isac" (p, p_) pt;
neuper@42394
   437
val (env, loc_, curry_arg, res, Safe, true) = scrstate;
neuper@42394
   438
  env2str env = "[\"\n(e_e, x + 1 = 2)\",\"\n(v_v, x)\"]";
neuper@42394
   439
  loc_ = [R, L, R, L, L, R, R];
neuper@42394
   440
  curry_arg = SOME (str2term "e_e::bool");
neuper@42394
   441
  term2str res = "x + 1 + -1 * 2 = 0";(* scrstate after norm_equation, before Test_simplify *)
neuper@42394
   442
term2str (go loc_ sc) = "Rewrite_Set norm_equation False";
neuper@42394
   443
neuper@42394
   444
val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*-------------------------------------------*)
neuper@42394
   445
val (p'''', pt'''') = (p, pt);
neuper@42394
   446
f2str f = "-1 + x = 0"; snd nxt = Subproblem ("Test", ["linear", "univariate", "equation", "test"]);
neuper@42394
   447
val (p, p_) = p(* = ([2], Res)*);
neuper@42394
   448
val (srls, (ScrState scrstate, ctxt), Script sc) = from_pblobj_or_detail' "Isac" (p, p_) pt;
neuper@42394
   449
val (env, loc_, curry_arg, res, Safe, false) = scrstate;
neuper@42394
   450
  env2str env = "[\"\n(e_e, x + 1 = 2)\",\"\n(v_v, x)\"]";
neuper@42394
   451
  loc_ = [R, L, R, L, R, R];
neuper@42394
   452
  curry_arg = SOME (str2term "e_e::bool");
neuper@42394
   453
  term2str res = "-1 + x = 0";           (* scrstate after Test_simplify, before Subproblem *)
neuper@42394
   454
term2str (go loc_ sc) = "Rewrite_Set Test_simplify False";
neuper@42394
   455
neuper@42394
   456
val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*-------------------------------------------*)
neuper@42394
   457
val (p'''', pt'''') = (p, pt);     (*f2str f = exception Match; ...is a model, not a formula*)
neuper@42394
   458
val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*-------------------------------------------*)
neuper@42394
   459
val (p'''', pt'''') = (p, pt);
neuper@42394
   460
val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*-------------------------------------------*)
neuper@42394
   461
val (p'''', pt'''') = (p, pt);
neuper@42394
   462
val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*-------------------------------------------*)
neuper@42394
   463
val (p'''', pt'''') = (p, pt);
neuper@42394
   464
val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*-------------------------------------------*)
neuper@42394
   465
val (p'''', pt'''') = (p, pt);
neuper@42394
   466
val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*-------------------------------------------*)
neuper@42394
   467
val (p'''', pt'''') = (p, pt);
neuper@42394
   468
val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*-------------------------------------------*)
neuper@42394
   469
val (p'''', pt'''') = (p, pt);
neuper@42394
   470
val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*nxt = Apply_Method ["Test", "solve_linear"]*)
neuper@42394
   471
(*from_pblobj_or_detail': no istate = from_pblobj_or_detail' "Isac" p pt;*)
neuper@42394
   472
neuper@42394
   473
val (p,_,f,nxt,_,pt) = me nxt p [] pt; (*---------------------------------------------------*)
neuper@42394
   474
val (p'''', pt'''') = (p, pt);
neuper@42394
   475
f2str f = "-1 + x = 0"; snd nxt = Rewrite_Set_Inst (["(bdv, x)"], "isolate_bdv");
neuper@42394
   476
val (p, p_) = p(* = ([3, 1], Frm)*);
neuper@42394
   477
val (srls, (ScrState scrstate, ctxt), Script sc) = from_pblobj_or_detail' "Isac" (p, p_) pt;
neuper@42394
   478
val (env, loc_, curry_arg, res, Safe, true) = scrstate;
neuper@42394
   479
  env2str env = "[\"\n(e_e, -1 + x = 0)\",\"\n(v_v, x)\"]";
neuper@42394
   480
  loc_ = [];
neuper@42394
   481
  curry_arg = NONE;
neuper@42394
   482
  term2str res = "??.empty";                     (* scrstate before starting interpretation *)
neuper@42394
   483
(*term2str (go loc_ sc) = "Script Solve_linear e_e v_v = ...*)
neuper@42394
   484
neuper@42394
   485
val (p,_,f,nxt,_,pt) = me nxt p'''' [] pt''''; (*-------------------------------------------*)
neuper@42394
   486
val (p'''', pt'''') = (p, pt);
neuper@42394
   487
f2str f = "x = 0 + -1 * -1"; snd nxt = Rewrite_Set "Test_simplify";
neuper@42394
   488
val (p, p_) = p(* = ([3, 1], Res)*);
neuper@42394
   489
val (srls, (ScrState scrstate, ctxt), Script sc) = from_pblobj_or_detail' "Isac" (p, p_) pt;
neuper@42394
   490
val (env, loc_, curry_arg, res, Safe, true) = scrstate;
neuper@42394
   491
  env2str env = "[\"\n(e_e, -1 + x = 0)\",\"\n(v_v, x)\"]";
neuper@42394
   492
  loc_ = [R, L, R, L, R, L, R];
neuper@42394
   493
  curry_arg = SOME (str2term "e_e::bool");
neuper@42394
   494
  term2str res = "x = 0 + -1 * -1";(* scrstate after isolate_bdv, before Test_simplify *)
neuper@42394
   495
term2str (go loc_ sc) = "Rewrite_Set_Inst [(bdv, v_v)] isolate_bdv False";
neuper@42394
   496
neuper@42394
   497