test/Tools/isac/Interpret/script.sml
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 28 Sep 2010 09:06:56 +0200
branchisac-update-Isa09-2
changeset 38031 460c24a6a6ba
parent 37981 b2877b9d455a
child 38058 ad0485155c0e
permissions -rw-r--r--
tuned error and writeln

# raise error --> error
# writeln in atomtyp, atomty, atomt and xmlsrc
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@37906
    15
"-----------------------------------------------------------------";
neuper@37906
    16
"-----------------------------------------------------------------";
neuper@37906
    17
"-----------------------------------------------------------------";
neuper@37906
    18
neuper@37906
    19
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
"----------- WN0509 why does next_tac doesnt find Substitute -----";
neuper@37906
    23
neuper@37906
    24
(*replace met 'IntegrierenUndKonstanteBestimmen' with this script...*)
neuper@37906
    25
val str = (*#1#*)
neuper@37906
    26
"Script BiegelinieScript                                             \
neuper@37906
    27
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
    28
\(rb_::bool list) (rm_::bool list) =                                  \
neuper@37981
    29
\  (let q___ = Take (M_b v_v = q__);                                          \
neuper@37906
    30
\       (M1__::bool) = ((Substitute [v_ = 0])) q___           \
neuper@37906
    31
\ in True)";
neuper@37906
    32
val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
    33
neuper@37906
    34
val str = (*#2#*)
neuper@37906
    35
"Script BiegelinieScript                                             \
neuper@37906
    36
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
    37
\(rb_::bool list) (rm_::bool list) =                                  \
neuper@37981
    38
\  (let q___ = Take (q_ v_v = q__);                                          \
neuper@37906
    39
\       (M1__::bool) = ((Substitute [v_ = 0]) @@ \
neuper@37906
    40
\                       (Substitute [M_b 0 = 0]))  q___          \
neuper@37906
    41
\ in True)";(*..doesnt find Substitute with ..@@ !!!!!!!!!!!!!!!!!!!!!*)
neuper@37906
    42
neuper@37906
    43
val str = (*#3#*)
neuper@37906
    44
"Script BiegelinieScript                                             \
neuper@37906
    45
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
    46
\(rb_::bool list) (rm_::bool list) =                                  \
neuper@37981
    47
\  (let q___ = Take (q_ v_v = q__);                                          \
neuper@37906
    48
\      (M1__::bool) = Substitute [v_ = 0]      q___ ;        \
neuper@37906
    49
\       M1__ =        Substitute [M_b 0 = 0]  M1__           \
neuper@37906
    50
\ in True)"
neuper@37906
    51
;
neuper@37906
    52
val str = (*#4#*)
neuper@37906
    53
"Script BiegelinieScript                                             \
neuper@37906
    54
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
    55
\(rb_::bool list) (rm_::bool list) =                                  \
neuper@37981
    56
\  (let q___ = Take (q_ v_v = q__);                                          \
neuper@37906
    57
\      (M1__::bool) = Substitute [v_ = 0]      q___ ;        \
neuper@37906
    58
\       M1__ =        Substitute [v_ = 1]      q___ ;        \
neuper@37906
    59
\       M1__ =        Substitute [v_ = 2]      q___ ;        \
neuper@37906
    60
\       M1__ =        Substitute [v_ = 3]      q___ ;        \
neuper@37906
    61
\       M1__ =        Substitute [M_b 0 = 0]  M1__           \
neuper@37906
    62
\ in True)"
neuper@37906
    63
;
neuper@37906
    64
val str = (*#5#*)
neuper@37906
    65
"Script BiegelinieScript                                             \
neuper@37906
    66
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
    67
\(rb_::bool list) (rm_::bool list) =                                  \
neuper@37981
    68
\  (let q___ = Take (M_b v_v = q__);                                          \
neuper@37906
    69
\      (M1__::bool) = Substitute [v_ = 0]      q___ ;        \
neuper@37906
    70
\       M2__ = Take q___ ;                                     \
neuper@37906
    71
\       M2__ =        Substitute [v_ = 2]      q___           \
neuper@37906
    72
\ in True)"
neuper@37906
    73
;
neuper@37906
    74
val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
    75
atomty sc';
neuper@37906
    76
val {scr=Script sc,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
neuper@37906
    77
(*---------------------------------------------------------------------
neuper@38031
    78
if sc = sc' then () else error"script.sml, doesnt find Substitute #1";
neuper@37906
    79
---------------------------------------------------------------------*)
neuper@37906
    80
neuper@37906
    81
val fmz = ["Traegerlaenge L",
neuper@37906
    82
	   "Streckenlast (- q_0 * x^^^2 / 2 + x * c + c_2)",
neuper@37906
    83
	   "Biegelinie y",
neuper@37906
    84
	   "RandbedingungenBiegung [y 0 = 0, y L = 0]",
neuper@37906
    85
	   "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
neuper@37906
    86
	   "FunktionsVariable x"];
neuper@37906
    87
val (dI',pI',mI') =
neuper@37906
    88
  ("Biegelinie.thy",["MomentBestimmte","Biegelinien"],
neuper@37906
    89
   ["IntegrierenUndKonstanteBestimmen"]);
neuper@37906
    90
val p = e_pos'; val c = [];
neuper@37906
    91
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
    92
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
    93
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
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;
neuper@37906
    98
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
    99
case nxt of (_, Apply_Method ["IntegrierenUndKonstanteBestimmen"]) => ()
neuper@38031
   100
	  | _ => error "script.sml, doesnt find Substitute #2";
neuper@37906
   101
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   102
(* *** generate1: not impl.for Substitute' !!!!!!!!!!(*#1#*)!!!!!!!!!!!*)
neuper@37906
   103
(* val nxt = ("Check_Postcond",.. !!!!!!!!!!!!!!!!!!!(*#2#*)!!!!!!!!!!!*)
neuper@37906
   104
neuper@37906
   105
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   106
(* *** generate1: not impl.for Empty_Tac_  !!!!!!!!!!(*#3#*)!!!!!!!!!!!*)
neuper@37906
   107
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   108
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   109
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   110
(*---------------------------------------------------------------------*)
neuper@37906
   111
case nxt of (_, End_Proof') => () 
neuper@38031
   112
	  | _ => error "script.sml, doesnt find Substitute #3";
neuper@37906
   113
(*---------------------------------------------------------------------*)
neuper@37906
   114
(*the reason, that next_tac didnt find the 2nd Substitute, was that
neuper@37906
   115
  the Take inbetween was missing, and thus the 2nd Substitute was applied
neuper@37906
   116
  the last formula in ctree, and not to argument from script*)
neuper@37906
   117
neuper@37906
   118
neuper@37906
   119
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
   120
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
   121
"----------- WN0509 Substitute 2nd part --------------------------";
neuper@37906
   122
(*replace met 'IntegrierenUndKonstanteBestimmen' with this script...*)
neuper@37906
   123
val str = (*Substitute ; Substitute works*)
neuper@37906
   124
"Script BiegelinieScript                                             \
neuper@37906
   125
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
   126
\(rb_::bool list) (rm_::bool list) =                                  "^
neuper@37906
   127
(*begin after the 2nd integrate*)
neuper@37981
   128
"  (let M__ = Take (M_b v_v = q__);                                     \
neuper@37906
   129
\       e1__ = nth_ 1 rm_ ;                                         \
neuper@37906
   130
\       (x1__::real) = argument_in (lhs e1__);                       \
neuper@37906
   131
\       (M1__::bool) = Substitute [v_ = x1__] M__;                   \
neuper@37906
   132
\        M1__        = Substitute [e1__] M1__                    \
neuper@37906
   133
\ in True)"
neuper@37906
   134
;
neuper@37906
   135
(*---^^^-OK-----------------------------------------------------------------*)
neuper@37906
   136
val sc' = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
   137
atomty sc';
neuper@37906
   138
(*---vvv-NOT ok-------------------------------------------------------------*)
neuper@37906
   139
val str = (*Substitute @@ Substitute does NOT work???*)
neuper@37906
   140
"Script BiegelinieScript                                             \
neuper@37906
   141
\(l_::real) (q__::real) (v_::real) (b_::real=>real)                    \
neuper@37906
   142
\(rb_::bool list) (rm_::bool list) =                                  "^
neuper@37906
   143
(*begin after the 2nd integrate*)
neuper@37981
   144
"  (let M__ = Take (M_b v_v = q__);                                     \
neuper@37906
   145
\       e1__ = nth_ 1 rm_ ;                                         \
neuper@37906
   146
\       (x1__::real) = argument_in (lhs e1__);                       \
neuper@37906
   147
\       (M1__::bool) = ((Substitute [v_ = x1__]) @@ \
neuper@37906
   148
\                       (Substitute [e1__]))        M__           \
neuper@37906
   149
\ in True)"
neuper@37906
   150
;
neuper@37906
   151
neuper@37906
   152
val {scr=Script sc,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
neuper@37906
   153
(*---------------------------------------------------------------------
neuper@38031
   154
if sc = sc' then () else error"script.sml, doesnt find Substitute #1";
neuper@37906
   155
---------------------------------------------------------------------*)
neuper@37906
   156
val fmz = ["Traegerlaenge L",
neuper@37906
   157
	   "Streckenlast (- q_0 * x^^^2 / 2 + x * c + c_2)",
neuper@37906
   158
	   "Biegelinie y",
neuper@37906
   159
	   "RandbedingungenBiegung [y 0 = 0, y L = 0]",
neuper@37906
   160
	   "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
neuper@37906
   161
	   "FunktionsVariable x"];
neuper@37906
   162
val (dI',pI',mI') =
neuper@37906
   163
  ("Biegelinie.thy",["MomentBestimmte","Biegelinien"],
neuper@37906
   164
   ["IntegrierenUndKonstanteBestimmen"]);
neuper@37906
   165
val p = e_pos'; val c = [];
neuper@37906
   166
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
   167
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   168
val (p,_,f,nxt,_,pt) = me nxt p c pt;val (p,_,f,nxt,_,pt) = me nxt p c pt;
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;
neuper@37906
   173
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   174
case nxt of (_, Apply_Method ["IntegrierenUndKonstanteBestimmen"]) => ()
neuper@38031
   175
	  | _ => error "script.sml, doesnt find Substitute #2";
neuper@37906
   176
trace_rewrite:=true;
neuper@37906
   177
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f(*------------------------*);
neuper@37906
   178
trace_rewrite:=false;
neuper@37906
   179
(*Exception TYPE raised:
neuper@37906
   180
Illegal type for constant "op =" :: "[real, bool] => bool"
neuper@37906
   181
Atools.argument'_in (Tools.lhs (ListG.nth_ (1 + -1 + -1) [])) =
neuper@37906
   182
ListG.nth_ (1 + -1 + -1) []
neuper@37906
   183
Exception-
neuper@37906
   184
   TYPE
neuper@37906
   185
      ("Illegal type for constant \"op =\" :: \"[real, bool] => bool\"",
neuper@37906
   186
         [],
neuper@37906
   187
         [Const ("Trueprop", "bool => prop") $
neuper@37906
   188
               (Const ("op =", "[RealDef.real, bool] => bool") $ ... $ ...)])
neuper@37906
   189
   raised
neuper@37906
   190
... this was because eval_argument_in took "argument_in (lhs (M_b 0 = 0))"
neuper@37906
   191
ie. the argument had not been simplified before          ^^^^^^^^^^^^^^^
neuper@37906
   192
thus corrected eval_argument_in OK*)
neuper@37906
   193
neuper@37906
   194
val {srls,...} = get_met ["IntegrierenUndKonstanteBestimmen"];
neuper@37906
   195
val e1__ = str2term"nth_ 1 [M_b 0 = 0, M_b L = 0]";
neuper@37906
   196
val e1__ = eval_listexpr_ Biegelinie.thy srls e1__; term2str e1__;
neuper@37906
   197
if term2str e1__ = "M_b 0 = 0" then () else 
neuper@38031
   198
error"script.sml diff.beh. eval_listexpr_ nth_ 1 [...";
neuper@37906
   199
neuper@37906
   200
(*TODO.WN050913 ??? doesnt eval_listexpr_ go into subterms ???...
neuper@37906
   201
val x1__ = str2term"argument_in (lhs (M_b 0 = 0))";
neuper@37906
   202
val x1__ = eval_listexpr_ Biegelinie.thy srls x1__; term2str x1__;
neuper@37906
   203
(*no rewrite*)
neuper@37906
   204
calculate_ Biegelinie.thy ("Tools.lhs", eval_rhs"eval_lhs_") x1__;
neuper@37926
   205
val SOME (str, t) = eval_lhs 0 "Tools.lhs" (str2term"lhs (M_b 0 = 0)") 0;*)
neuper@37906
   206
neuper@37906
   207
val l__ = str2term"lhs (M_b 0 = 0)";
neuper@37906
   208
val l__ = eval_listexpr_ Biegelinie.thy srls l__; term2str l__;
neuper@37926
   209
val SOME (str, t) = eval_lhs 0 "Tools.lhs" (str2term"lhs (M_b 0 = 0)") 0;
neuper@37906
   210
neuper@37906
   211
neuper@37906
   212
trace_rewrite:=true;
neuper@37906
   213
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f(*------------------------*);
neuper@37906
   214
trace_rewrite:=false;
neuper@37906
   215
neuper@37906
   216
show_mets();
neuper@37906
   217
neuper@37906
   218
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@37906
   219
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@37906
   220
"----------- fun sel_appl_atomic_tacs ----------------------------";
neuper@37906
   221
states:=[];
neuper@37906
   222
CalcTree
neuper@37906
   223
[(["equality (x+1=2)", "solveFor x","solutions L"], 
neuper@37906
   224
  ("Test.thy", 
neuper@37906
   225
   ["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@37906
   250