test/Tools/isac/Interpret/script.sml
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 03 May 2011 16:20:55 +0200
branchdecompose-isar
changeset 41970 25957ffe68e8
parent 41969 a350b4ed575b
child 41972 22c5483e9bfb
permissions -rw-r--r--
provided all "x+1=2" with typeconstraint real ("equality" is just bool)
neuper@37906
     1
(* tests for ME/script.sml
neuper@37906
     2
   TODO.WN0509 collect typical tests from systest here !!!!!
neuper@37906
     3
   author: Walther Neuper 050908
neuper@37906
     4
   (c) copyright due to lincense terms.
neuper@37906
     5
neuper@37906
     6
use"../smltest/ME/script.sml";
neuper@37906
     7
use"script.sml";
neuper@37906
     8
*)
neuper@37906
     9
"-----------------------------------------------------------------";
neuper@37906
    10
"table of contents -----------------------------------------------";
neuper@37906
    11
"-----------------------------------------------------------------";
neuper@37906
    12
"----------- WN0509 why does next_tac doesnt find Substitute -----";
neuper@37906
    13
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
    14
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@41969
    15
"----------- fun init_form, fun get_stac -------------------------";
neuper@37906
    16
"-----------------------------------------------------------------";
neuper@37906
    17
"-----------------------------------------------------------------";
neuper@37906
    18
"-----------------------------------------------------------------";
neuper@37906
    19
neuper@41969
    20
(*========== inhibit exn 110503 ================================================
neuper@37906
    21
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
"----------- WN0509 why does next_tac doesnt find Substitute -----";
neuper@37906
    25
neuper@37906
    26
(*replace met 'IntegrierenUndKonstanteBestimmen' with this script...*)
neuper@37906
    27
val str = (*#1#*)
neuper@37906
    28
"Script BiegelinieScript                                             \
neuper@37906
    29
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
    30
\(rb_::bool list) (rm_::bool list) =                                  \
neuper@37981
    31
\  (let q___ = Take (M_b v_v = q__);                                          \
neuper@37906
    32
\       (M1__::bool) = ((Substitute [v_ = 0])) q___           \
neuper@37906
    33
\ in True)";
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#*)
neuper@37906
    37
"Script BiegelinieScript                                             \
neuper@37906
    38
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
    39
\(rb_::bool list) (rm_::bool list) =                                  \
neuper@37981
    40
\  (let q___ = Take (q_ v_v = q__);                                          \
neuper@37906
    41
\       (M1__::bool) = ((Substitute [v_ = 0]) @@ \
neuper@37906
    42
\                       (Substitute [M_b 0 = 0]))  q___          \
neuper@37906
    43
\ in True)";(*..doesnt find Substitute with ..@@ !!!!!!!!!!!!!!!!!!!!!*)
neuper@37906
    44
neuper@37906
    45
val str = (*#3#*)
neuper@37906
    46
"Script BiegelinieScript                                             \
neuper@37906
    47
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
    48
\(rb_::bool list) (rm_::bool list) =                                  \
neuper@37981
    49
\  (let q___ = Take (q_ v_v = q__);                                          \
neuper@37906
    50
\      (M1__::bool) = Substitute [v_ = 0]      q___ ;        \
neuper@37906
    51
\       M1__ =        Substitute [M_b 0 = 0]  M1__           \
neuper@37906
    52
\ in True)"
neuper@37906
    53
;
neuper@37906
    54
val str = (*#4#*)
neuper@37906
    55
"Script BiegelinieScript                                             \
neuper@37906
    56
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
    57
\(rb_::bool list) (rm_::bool list) =                                  \
neuper@37981
    58
\  (let q___ = Take (q_ v_v = q__);                                          \
neuper@37906
    59
\      (M1__::bool) = Substitute [v_ = 0]      q___ ;        \
neuper@37906
    60
\       M1__ =        Substitute [v_ = 1]      q___ ;        \
neuper@37906
    61
\       M1__ =        Substitute [v_ = 2]      q___ ;        \
neuper@37906
    62
\       M1__ =        Substitute [v_ = 3]      q___ ;        \
neuper@37906
    63
\       M1__ =        Substitute [M_b 0 = 0]  M1__           \
neuper@37906
    64
\ in True)"
neuper@37906
    65
;
neuper@37906
    66
val str = (*#5#*)
neuper@37906
    67
"Script BiegelinieScript                                             \
neuper@37906
    68
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
    69
\(rb_::bool list) (rm_::bool list) =                                  \
neuper@37981
    70
\  (let q___ = Take (M_b v_v = q__);                                          \
neuper@37906
    71
\      (M1__::bool) = Substitute [v_ = 0]      q___ ;        \
neuper@37906
    72
\       M2__ = Take q___ ;                                     \
neuper@37906
    73
\       M2__ =        Substitute [v_ = 2]      q___           \
neuper@37906
    74
\ in True)"
neuper@37906
    75
;
neuper@37906
    76
val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
    77
atomty sc';
neuper@37906
    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
val fmz = ["Traegerlaenge L",
neuper@37906
    84
	   "Streckenlast (- q_0 * x^^^2 / 2 + x * c + c_2)",
neuper@37906
    85
	   "Biegelinie y",
neuper@37906
    86
	   "RandbedingungenBiegung [y 0 = 0, y L = 0]",
neuper@37906
    87
	   "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
neuper@37906
    88
	   "FunktionsVariable x"];
neuper@37906
    89
val (dI',pI',mI') =
neuper@38058
    90
  ("Biegelinie",["MomentBestimmte","Biegelinien"],
neuper@37906
    91
   ["IntegrierenUndKonstanteBestimmen"]);
neuper@37906
    92
val p = e_pos'; val c = [];
neuper@37906
    93
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
    94
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
    95
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
    96
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
    97
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
    98
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
    99
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   100
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   101
case nxt of (_, Apply_Method ["IntegrierenUndKonstanteBestimmen"]) => ()
neuper@38031
   102
	  | _ => error "script.sml, doesnt find Substitute #2";
neuper@37906
   103
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   104
(* *** generate1: not impl.for Substitute' !!!!!!!!!!(*#1#*)!!!!!!!!!!!*)
neuper@37906
   105
(* val nxt = ("Check_Postcond",.. !!!!!!!!!!!!!!!!!!!(*#2#*)!!!!!!!!!!!*)
neuper@37906
   106
neuper@37906
   107
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   108
(* *** generate1: not impl.for Empty_Tac_  !!!!!!!!!!(*#3#*)!!!!!!!!!!!*)
neuper@37906
   109
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   110
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   111
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   112
(*---------------------------------------------------------------------*)
neuper@37906
   113
case nxt of (_, End_Proof') => () 
neuper@38031
   114
	  | _ => error "script.sml, doesnt find Substitute #3";
neuper@37906
   115
(*---------------------------------------------------------------------*)
neuper@37906
   116
(*the reason, that next_tac didnt find the 2nd Substitute, was that
neuper@37906
   117
  the Take inbetween was missing, and thus the 2nd Substitute was applied
neuper@37906
   118
  the last formula in ctree, and not to argument from script*)
neuper@37906
   119
neuper@37906
   120
neuper@37906
   121
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
   122
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
   123
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
   124
(*replace met 'IntegrierenUndKonstanteBestimmen' with this script...*)
neuper@37906
   125
val str = (*Substitute ; Substitute works*)
neuper@37906
   126
"Script BiegelinieScript                                             \
neuper@37906
   127
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
   128
\(rb_::bool list) (rm_::bool list) =                                  "^
neuper@37906
   129
(*begin after the 2nd integrate*)
neuper@37981
   130
"  (let M__ = Take (M_b v_v = q__);                                     \
neuper@37906
   131
\       e1__ = nth_ 1 rm_ ;                                         \
neuper@37906
   132
\       (x1__::real) = argument_in (lhs e1__);                       \
neuper@37906
   133
\       (M1__::bool) = Substitute [v_ = x1__] M__;                   \
neuper@37906
   134
\        M1__        = Substitute [e1__] M1__                    \
neuper@37906
   135
\ in True)"
neuper@37906
   136
;
neuper@37906
   137
(*---^^^-OK-----------------------------------------------------------------*)
neuper@37906
   138
val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
   139
atomty sc';
neuper@37906
   140
(*---vvv-NOT ok-------------------------------------------------------------*)
neuper@37906
   141
val str = (*Substitute @@ Substitute does NOT work???*)
neuper@37906
   142
"Script BiegelinieScript                                             \
neuper@37906
   143
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
   144
\(rb_::bool list) (rm_::bool list) =                                  "^
neuper@37906
   145
(*begin after the 2nd integrate*)
neuper@37981
   146
"  (let M__ = Take (M_b v_v = q__);                                     \
neuper@37906
   147
\       e1__ = nth_ 1 rm_ ;                                         \
neuper@37906
   148
\       (x1__::real) = argument_in (lhs e1__);                       \
neuper@37906
   149
\       (M1__::bool) = ((Substitute [v_ = x1__]) @@ \
neuper@37906
   150
\                       (Substitute [e1__]))        M__           \
neuper@37906
   151
\ in True)"
neuper@37906
   152
;
neuper@37906
   153
neuper@37906
   154
val {scr=Script sc,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
neuper@37906
   155
(*---------------------------------------------------------------------
neuper@38031
   156
if sc = sc' then () else error"script.sml, doesnt find Substitute #1";
neuper@37906
   157
---------------------------------------------------------------------*)
neuper@37906
   158
val fmz = ["Traegerlaenge L",
neuper@37906
   159
	   "Streckenlast (- q_0 * x^^^2 / 2 + x * c + c_2)",
neuper@37906
   160
	   "Biegelinie y",
neuper@37906
   161
	   "RandbedingungenBiegung [y 0 = 0, y L = 0]",
neuper@37906
   162
	   "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
neuper@37906
   163
	   "FunktionsVariable x"];
neuper@37906
   164
val (dI',pI',mI') =
neuper@38058
   165
  ("Biegelinie",["MomentBestimmte","Biegelinien"],
neuper@37906
   166
   ["IntegrierenUndKonstanteBestimmen"]);
neuper@37906
   167
val p = e_pos'; val c = [];
neuper@37906
   168
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
   169
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   170
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   171
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   172
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   173
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   174
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   175
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   176
case nxt of (_, Apply_Method ["IntegrierenUndKonstanteBestimmen"]) => ()
neuper@38031
   177
	  | _ => error "script.sml, doesnt find Substitute #2";
neuper@37906
   178
trace_rewrite:=true;
neuper@37906
   179
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f(*------------------------*);
neuper@37906
   180
trace_rewrite:=false;
neuper@37906
   181
(*Exception TYPE raised:
neuper@41922
   182
Illegal type for constant "HOL.eq" :: "[real, bool] => bool"
neuper@37906
   183
Atools.argument'_in (Tools.lhs (ListG.nth_ (1 + -1 + -1) [])) =
neuper@37906
   184
ListG.nth_ (1 + -1 + -1) []
neuper@37906
   185
Exception-
neuper@37906
   186
   TYPE
neuper@37906
   187
      ("Illegal type for constant \"op =\" :: \"[real, bool] => bool\"",
neuper@37906
   188
         [],
neuper@41924
   189
         [Const ("HOL.Trueprop", "bool => prop") $
neuper@41922
   190
               (Const ("HOL.eq", "[RealDef.real, bool] => bool") $ ... $ ...)])
neuper@37906
   191
   raised
neuper@37906
   192
... this was because eval_argument_in took "argument_in (lhs (M_b 0 = 0))"
neuper@37906
   193
ie. the argument had not been simplified before          ^^^^^^^^^^^^^^^
neuper@37906
   194
thus corrected eval_argument_in OK*)
neuper@37906
   195
neuper@37906
   196
val {srls,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
neuper@37906
   197
val e1__ = str2term"nth_ 1 [M_b 0 = 0, M_b L = 0]";
neuper@37906
   198
val e1__ = eval_listexpr_ Biegelinie.thy srls e1__; term2str e1__;
neuper@37906
   199
if term2str e1__ = "M_b 0 = 0" then () else 
neuper@38031
   200
error"script.sml diff.beh. eval_listexpr_ nth_ 1 [...";
neuper@37906
   201
neuper@37906
   202
(*TODO.WN050913 ??? doesnt eval_listexpr_ go into subterms ???...
neuper@37906
   203
val x1__ = str2term"argument_in (lhs (M_b 0 = 0))";
neuper@37906
   204
val x1__ = eval_listexpr_ Biegelinie.thy srls x1__; term2str x1__;
neuper@37906
   205
(*no rewrite*)
neuper@37906
   206
calculate_ Biegelinie.thy ("Tools.lhs", eval_rhs"eval_lhs_") x1__;
neuper@37926
   207
val SOME (str, t) = eval_lhs 0 "Tools.lhs" (str2term"lhs (M_b 0 = 0)") 0;*)
neuper@37906
   208
neuper@37906
   209
val l__ = str2term"lhs (M_b 0 = 0)";
neuper@37906
   210
val l__ = eval_listexpr_ Biegelinie.thy srls l__; term2str l__;
neuper@37926
   211
val SOME (str, t) = eval_lhs 0 "Tools.lhs" (str2term"lhs (M_b 0 = 0)") 0;
neuper@37906
   212
neuper@37906
   213
neuper@37906
   214
trace_rewrite:=true;
neuper@37906
   215
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f(*------------------------*);
neuper@37906
   216
trace_rewrite:=false;
neuper@37906
   217
neuper@37906
   218
show_mets();
neuper@37906
   219
neuper@37906
   220
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@37906
   221
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@37906
   222
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@37906
   223
states:=[];
neuper@41970
   224
CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   225
  ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   226
   ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   227
Iterator 1;
neuper@37906
   228
moveActiveRoot 1;
neuper@37906
   229
autoCalculate 1 CompleteCalcHead;
neuper@37906
   230
autoCalculate 1 (Step 1);
neuper@37906
   231
autoCalculate 1 (Step 1);
neuper@37906
   232
val ((pt, p), _) = get_calc 1; show_pt pt;
neuper@37906
   233
val appltacs = sel_appl_atomic_tacs pt p;
neuper@37906
   234
if appltacs = 
neuper@37906
   235
   [Rewrite ("radd_commute", "?m + ?n = ?n + ?m"),
neuper@37906
   236
    Rewrite ("radd_assoc", "?m + ?n + ?k = ?m + (?n + ?k)"),
neuper@37906
   237
    Calculate "times"] then ()
neuper@38031
   238
else error "script.sml fun sel_appl_atomic_tacs diff.behav.";
neuper@37906
   239
neuper@37906
   240
trace_script := true;
neuper@37906
   241
trace_script := false;
neuper@37906
   242
applyTactic 1 p (hd appltacs);
neuper@37906
   243
val ((pt, p), _) = get_calc 1; show_pt pt;
neuper@37906
   244
val appltacs = sel_appl_atomic_tacs pt p;
neuper@37906
   245
neuper@37906
   246
"----- WN080102 these vvv do not work, because locatetac starts the search\
neuper@37906
   247
 \1 stac too low";
neuper@37906
   248
applyTactic 1 p (hd appltacs);
neuper@37906
   249
autoCalculate 1 CompleteCalc;
neuper@41969
   250
============ inhibit exn 110503 ==============================================*)
neuper@37906
   251
neuper@41969
   252
"----------- fun init_form, fun get_stac -------------------------";
neuper@41969
   253
"----------- fun init_form, fun get_stac -------------------------";
neuper@41969
   254
"----------- fun init_form, fun get_stac -------------------------";
neuper@41969
   255
val fmz = ["equality (x+1=(2::real))", "solveFor x", "solutions L"];
neuper@41969
   256
val (dI',pI',mI') = ("Test",["sqroot-test","univariate","equation","test"],
neuper@41969
   257
  ["Test","squ-equ-test-subpbl1"]);
neuper@41969
   258
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@41969
   259
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   260
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   261
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   262
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   263
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   264
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   265
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@41969
   266
"~~~~~ fun me, args:"; val (_,tac) = nxt;
neuper@41969
   267
"~~~~~ fun locatetac, args:"; val ptp as (pt, p) = (pt, p);
neuper@41969
   268
val (mI,m) = mk_tac'_ tac;
neuper@41969
   269
val Appl m = applicable_in p pt m;
neuper@41969
   270
member op = specsteps mI; (*false*)
neuper@41969
   271
"~~~~~ fun loc_solve_, args:"; val (m, (pt, pos) ) = ((mI, m), ptp);
neuper@41969
   272
"~~~~~ fun solve, args:"; val (("Apply_Method", Apply_Method' (mI,_,_,_)), pos as (p,_)) = (m, pos);
neuper@41969
   273
val {srls, ...} = get_met mI;
neuper@41969
   274
val PblObj {meth=itms, ...} = get_obj I pt p;
neuper@41969
   275
val thy' = get_obj g_domID pt p;
neuper@41969
   276
val thy = assoc_thy thy';
neuper@41969
   277
val (is as ScrState (env,_,_,_,_,_), ctxt, sc) = init_scrstate thy itms mI;
neuper@41969
   278
val ini = init_form thy sc env;
neuper@41969
   279
"----- fun init_form, args:"; val (Script sc) = sc;
neuper@41969
   280
"----- fun get_stac, args:"; val (y, h $ body) = (thy, sc);
neuper@41969
   281
case get_stac thy sc of SOME (Free ("e_e", _)) => ()
neuper@41969
   282
| _ => error "script: Const (?, ?) in script (as term) changed";;
neuper@41969
   283