test/Tools/isac/ProgLang/calculate.sml
author Walther Neuper <wneuper@ist.tugraz.at>
Sun, 25 Feb 2018 14:02:42 +0100
changeset 59387 ae0b7006fc28
parent 59384 d92ff7591a11
child 59388 47877d6fa35a
permissions -rw-r--r--
Calc: cleanup source file
neuper@38022
     1
(* Title:  test calculation of values for function constants
neuper@38022
     2
   Author: Walther Neuper 2000
neuper@38022
     3
   (c) copyright due to lincense terms.
neuper@37906
     4
*)
neuper@37906
     5
neuper@38022
     6
"--------------------------------------------------------";
neuper@38022
     7
"table of contents --------------------------------------";
neuper@38022
     8
"--------------------------------------------------------";
neuper@55366
     9
"-calculate.thy: provides 'setup' -----------------------";
neuper@41924
    10
"----------- fun norm -----------------------------------";
wneuper@59255
    11
"----------- check return value of adhoc_thm  ----";
neuper@38032
    12
"----------- fun calculate_ -----------------------------";
neuper@55366
    13
"----------- calculate from script --requires 'setup'----";
neuper@38032
    14
"----------- calculate check test-root-equ --------------";
wneuper@59253
    15
"----------- check calcul,ate bottom up -----------------";
neuper@42223
    16
"----------- Atools.pow Power.power_class.power ---------";
neuper@41934
    17
" ================= calculate.sml: calculate_ 2002 ======";
neuper@38032
    18
"----------- get_pair with 3 args -----------------------";
neuper@38032
    19
"----------- calculate (2 * x is_const) -----------------";
wneuper@59387
    20
"----------- fun get_pair: examples ------------------------------------------------------------";
wneuper@59387
    21
"----------- fun adhoc_thm: examples -----------------------------------------------------------";
neuper@38022
    22
"--------------------------------------------------------";
neuper@38022
    23
"--------------------------------------------------------";
neuper@38022
    24
"--------------------------------------------------------";
neuper@37906
    25
wneuper@59255
    26
"----------- check return value of adhoc_thm  ----";
wneuper@59255
    27
"----------- check return value of adhoc_thm  ----";
wneuper@59255
    28
"----------- check return value of adhoc_thm  ----";
neuper@41924
    29
val thy = @{theory "Poly"};
s1210629013@52153
    30
val cal = snd (assoc_calc' thy "is_polyexp");
neuper@38022
    31
val t = @{term "(x / x) is_polyexp"};
wneuper@59255
    32
val SOME (thmID, thm) = adhoc_thm thy cal t;
wneuper@59188
    33
(HOLogic.dest_Trueprop (Thm.prop_of thm); writeln "all thms wrapped by Trueprop")
neuper@38022
    34
handle TERM _ => 
wneuper@59255
    35
       error "calculate.sml: adhoc_thm must return Trueprop";
neuper@38022
    36
neuper@38033
    37
"----------- fun calculate_ -----------------------------";
neuper@38033
    38
"----------- fun calculate_ -----------------------------";
neuper@38033
    39
"----------- fun calculate_ -----------------------------";
neuper@41924
    40
val thy = @{theory "Test"};
neuper@38033
    41
"===== test 1";
wneuper@59188
    42
val t = (Thm.term_of o the o (parse thy)) "1+2";
wneuper@59255
    43
val SOME (thmID,thm) = adhoc_thm thy (the(assoc(calclist,"PLUS"))) t;
wneuper@59195
    44
term2str (Thm.prop_of thm) = "1 + 2 = 3";
neuper@38033
    45
neuper@38033
    46
"===== test 2";
wneuper@59188
    47
val t = (Thm.term_of o the o (parse thy)) "((1+2)*4/3)^^^2";
wneuper@59255
    48
val SOME (thmID,thm) = adhoc_thm thy (the(assoc(calclist,"PLUS"))) t;
neuper@38033
    49
val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@41931
    50
if term2str t = "(3 * 4 / 3) ^^^ 2" then ()
neuper@41931
    51
else error "calculate.sml: ((1+2)*4/3)^^^2 --> (3 * 4 / 3) ^^^ 2";
neuper@38033
    52
neuper@38033
    53
"===== test 3b -- 2 contiued";
wneuper@59255
    54
val SOME (thmID,thm) = adhoc_thm thy (the(assoc(calclist,"TIMES"))) t;
neuper@38033
    55
val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@38033
    56
term2str t;
neuper@38033
    57
(*val it = "(#12 // #3) ^^^ #2" : string*)
neuper@37906
    58
neuper@38033
    59
"===== test 4";
wneuper@59255
    60
val SOME (thmID,thm) = adhoc_thm thy(the(assoc(calclist,"DIVIDE")))t;
neuper@38032
    61
val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@38033
    62
term2str t;
neuper@38033
    63
(*it = "#4 ^^^ #2" : string*)
neuper@38033
    64
neuper@38033
    65
"===== test 5";
wneuper@59255
    66
val SOME (thmID,thm) = adhoc_thm thy(the(assoc(calclist,"POWER")))t;
neuper@38032
    67
val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@41931
    68
(*show_types := false;*)
neuper@38037
    69
if term2str t <> "16" then error "calculate.sml: new behaviour in calculate_"
neuper@37906
    70
else ();
neuper@37906
    71
neuper@37906
    72
neuper@37906
    73
val fmz = ["realTestGiven (((1+2)*4/3)^^^2)","realTestFind s"];
neuper@37906
    74
val (dI',pI',mI') =
neuper@38035
    75
  ("Test",["calculate","test"],["Test","test_calculate"]);
neuper@38035
    76
neuper@37906
    77
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
    78
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
    79
(*nxt =("Add_Given",Add_Given "realTestGiven (((#1 + #2) * #4 // #3) ^^^#2)")*)
neuper@37906
    80
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
    81
(*nxt = ("Add_Find",Add_Find "realTestFind s") : string * tac*)
neuper@37906
    82
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38035
    83
(*nxt = ("Specify_Theory",Specify_Theory "Test") : string * tac*)
neuper@37906
    84
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
    85
(*nxt = ("Specify_Problem",Specify_Problem ["calculate","test"])*)
neuper@37906
    86
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38035
    87
(*nxt = ("Specify_Method",Specify_Method ("Test","test_calculate"))*)
neuper@37906
    88
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38035
    89
(*nxt = ("Apply_Method",Apply_Method ("Test","test_calculate"))*)
neuper@37906
    90
neuper@37906
    91
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38033
    92
(*nxt = ("Calculate",Calculate "PLUS")*)
neuper@37906
    93
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38033
    94
(*nxt = ("Calculate",Calculate "TIMES")*)
neuper@37906
    95
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38033
    96
(*nxt = ("Calculate",Calculate "DIVIDE")*)
neuper@37906
    97
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38033
    98
(*nxt = ("Calculate",Calculate "POWER")*)
neuper@37906
    99
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   100
(*nxt = ("Check_Postcond",Check_Postcond ["calculate","test"])*)
neuper@37906
   101
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   102
(*nxt = ("End_Proof'",End_Proof')*)
wneuper@59267
   103
case f of FormKF "16" => () | _ =>
wneuper@59253
   104
error "calculate.sml: script test_calculate changed behaviour";
neuper@37906
   105
neuper@37906
   106
neuper@38032
   107
"----------- calculate check test-root-equ --------------";
neuper@38032
   108
"----------- calculate check test-root-equ --------------";
neuper@38032
   109
"----------- calculate check test-root-equ --------------";
neuper@37906
   110
(*(1): 2nd Test_simplify didn't work:
neuper@37906
   111
val ct =
neuper@37906
   112
  "sqrt (x ^^^ 2 + -3 * x) = (-3 + 2 * x + -1 * (9 + 4 * x)) / (-1 * 2)"
neuper@37906
   113
> val rls = ("Test_simplify");
neuper@37906
   114
> val (ct,_) = the (rewrite_set thy' ("tval_rls") false rls ct);
neuper@37906
   115
val ct = "sqrt (x ^^^ 2 + -3 * x) =
neuper@37906
   116
(-9) / (-2) + (-3 / (-2) + (x * ((-4) / (-2)) + x * (2 / (-2))))";
neuper@37906
   117
ie. cancel does not work properly
neuper@37906
   118
*)
wneuper@59382
   119
 val thy = @{theory "Test"};
wneuper@59382
   120
 val op_ = the (assoc (calclist, "DIVIDE"));
wneuper@59382
   121
 val ct = numbers_to_string @{term
wneuper@59382
   122
   "sqrt (x ^^^ 2 + -3 * x) = (-9) / (-2) + (-3 / (-2) + (x * ((-4) / (-2)) + x * (2 / (-2))))"};
wneuper@59382
   123
case calculate_ thy op_ ct of
wneuper@59382
   124
  SOME _ => ()
wneuper@59382
   125
| NONE => error "calculate_ test-root-equ changed";
neuper@37906
   126
(*
neuper@37906
   127
           sqrt (x ^^^ 2 + -3 * x) =\
neuper@37906
   128
 \(-9) / (-2) + (-3 / (-2) + (x * ((-4) / (-2)) + x * (2 / (-2))))
neuper@37906
   129
............... does not work *)
neuper@37906
   130
neuper@37906
   131
(*--------------(2): does divide work in Test_simplify ?: ------*)
akargl@42188
   132
 val thy = @{theory Test};
wneuper@59188
   133
 val t = (Thm.term_of o the o (parse thy)) "6 / 2";
neuper@37906
   134
 val rls = Test_simplify;
neuper@37906
   135
 val (t,_) = the (rewrite_set_ thy false rls t);
neuper@55279
   136
(*val t = Free ("3","Real.real") : term*)
neuper@37906
   137
neuper@37906
   138
(*--------------(3): is_const works ?: -------------------------------------*)
wneuper@59188
   139
 val t = (Thm.term_of o the o (parse @{theory Test})) "2 is_const";
neuper@37906
   140
 atomty t;
akargl@42188
   141
 rewrite_set_ @{theory Test} false tval_rls t;
neuper@41928
   142
(*val it = SOME (Const ("HOL.True","bool"),[]) ... works*)
neuper@37906
   143
neuper@37906
   144
 val t = str2term "2 * x is_const";
akargl@42188
   145
 val SOME (str,t') = eval_const "" "" t (@{theory "Isac"});
neuper@37906
   146
 term2str t';
neuper@37906
   147
 
neuper@37906
   148
neuper@38032
   149
"----------- check calculate bottom up ------------------";
neuper@38032
   150
"----------- check calculate bottom up ------------------";
neuper@38032
   151
"----------- check calculate bottom up ------------------";
neuper@37906
   152
(*-------------- eval_cancel works: *)
neuper@52070
   153
 trace_rewrite:=false;
akargl@42188
   154
 val thy = @{theory Test};
wneuper@59384
   155
 val rls = Test_simplify;
wneuper@59188
   156
 val t = (Thm.term_of o the o (parse thy)) "(-4) / 2";
akargl@42188
   157
wneuper@59360
   158
val SOME (_, t) = eval_cancel "xxx" "Rings.divide_class.divide" t thy;
akargl@42188
   159
neuper@37906
   160
(*--------------(5): reproduce (1) with simpler term: ------------*)
wneuper@59384
   161
 val t = (Thm.term_of o the o (parse thy)) "(3+5)/2";
wneuper@59384
   162
case rewrite_set_ thy false rls t of
wneuper@59384
   163
  SOME (Free ("4", _), []) => ()
wneuper@59384
   164
| _ => error "rewrite_set_ (3+5)/2 changed";
neuper@37906
   165
wneuper@59384
   166
 val t = (Thm.term_of o the o (parse thy)) "(3+1+2*x)/2";
wneuper@59384
   167
case rewrite_set_ thy false rls t of
wneuper@59384
   168
  SOME (Const ("Groups.plus_class.plus", _) $ Free ("2", _) $ Free ("x", _), []) => ()
wneuper@59384
   169
| _ => error "rewrite_set_ (3+1+2*x)/2 changed";
neuper@37906
   170
neuper@52070
   171
 trace_rewrite:=false; (*=true3.6.03*)
akargl@42218
   172
neuper@37906
   173
(*--- trace_rewrite before correction of ... --------------------
neuper@37906
   174
 val ct = "(-3 + 2 * x + -1) / 2";
neuper@37906
   175
 val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   176
:
neuper@37906
   177
### trying thm 'root_ge0_2'
neuper@37906
   178
### rewrite_set_: x + (-1 + -3) / 2
neuper@37906
   179
### trying thm 'radd_real_const_eq'
neuper@37906
   180
### trying thm 'radd_real_const'
neuper@37906
   181
### rewrite_set_: x + (-4) / 2
neuper@37906
   182
### trying thm 'rcollect_right'
neuper@37906
   183
:
neuper@37906
   184
"x + (-4) / 2"
neuper@37906
   185
-------------------------------------while before Isabelle20002:
neuper@37906
   186
 val ct = "(#-3 + #2 * x + #-1) // #2";
neuper@37906
   187
 val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   188
:
neuper@37906
   189
### trying thm 'root_ge0_2'
neuper@37906
   190
### rewrite_set_: x + (#-1 + #-3) // #2
neuper@37906
   191
### trying thm 'radd_real_const_eq'
neuper@37906
   192
### trying thm 'radd_real_const'
neuper@37906
   193
### rewrite_set_: x + #-4 // #2
neuper@37906
   194
### rewrite_set_: x + #-2
neuper@37906
   195
### trying thm 'rcollect_right'
neuper@37906
   196
:
neuper@37906
   197
"#-2 + x"
neuper@37906
   198
-----------------------------------------------------------------*)
neuper@37906
   199
neuper@37906
   200
neuper@37906
   201
(*===================*)
neuper@52070
   202
 trace_rewrite:=false; (*WN130722: =true stopped Test_Isac.thy*)
wneuper@59384
   203
 val t = (Thm.term_of o the o (parse thy))  "x + (-1 + -3) / 2";
wneuper@59384
   204
val SOME (res, []) = rewrite_set_ thy false rls t;
wneuper@59384
   205
if term2str res = "-2 + x" then () else error "rewrite_set_  x + (-1 + -3) / 2  changed";
neuper@37906
   206
"x + (-4) / 2";						
neuper@37906
   207
(*
neuper@37906
   208
### trying calc. 'cancel'
neuper@37906
   209
@@@ get_pair: binop, t = x + (-4) / 2
neuper@37906
   210
@@@ get_pair: t else
neuper@38032
   211
@@@ get_pair: t else -> NONE
neuper@37906
   212
@@@ get_pair: binop, t = (-4) / 2
neuper@37906
   213
@@@ get_pair: then 1
neuper@38032
   214
@@@ get_pair: t -> NONE
neuper@38032
   215
@@@ get_pair: t1 -> NONE
wneuper@59255
   216
@@@ adhoc_thm': NONE
neuper@37906
   217
### trying calc. 'pow'
neuper@37906
   218
*)
neuper@37906
   219
neuper@52070
   220
 trace_rewrite:=false; (*WN130722: =true stopped Test_Isac.thy*)
neuper@37906
   221
neuper@42223
   222
"----------- Atools.pow Power.power_class.power ---------";
neuper@42223
   223
"----------- Atools.pow Power.power_class.power ---------";
neuper@42223
   224
"----------- Atools.pow Power.power_class.power ---------";
wneuper@59188
   225
val t = (Thm.term_of o the o (parseold thy)) "1 ^ aaa";
neuper@42223
   226
atomty t;
neuper@37906
   227
(*** -------------
neuper@37906
   228
*** Const ( Nat.power, ['a, nat] => 'a)
neuper@37906
   229
*** . Free ( 1, 'a)
neuper@37906
   230
*** . Free ( aaa, nat) *)
akargl@42218
   231
neuper@42223
   232
val t = str2term "1 ^^^ aaa";
neuper@42223
   233
atomty t;
neuper@42223
   234
(**** 
neuper@42223
   235
*** Const (Atools.pow, real => real => real)
neuper@42223
   236
*** . Free (1, real)
neuper@42223
   237
*** . Free (aaa, real)
neuper@42223
   238
*** *);
neuper@37906
   239
neuper@37906
   240
" ================= calculate.sml: calculate_ 2002 =================== ";
neuper@37906
   241
" ================= calculate.sml: calculate_ 2002 =================== ";
neuper@37906
   242
" ================= calculate.sml: calculate_ 2002 =================== ";
neuper@37906
   243
akargl@42188
   244
val thy = @{theory Test};
wneuper@59188
   245
val t = (Thm.term_of o the o (parse thy)) "12 / 3";
wneuper@59255
   246
val SOME (thmID,thm) = adhoc_thm thy(the(assoc(calclist,"DIVIDE")))t;
neuper@38032
   247
val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@37906
   248
"12 / 3 = 4";
akargl@42188
   249
val thy = @{theory Test};
wneuper@59188
   250
val t = (Thm.term_of o the o (parse thy)) "4 ^^^ 2";
wneuper@59255
   251
val SOME (thmID,thm) = adhoc_thm thy(the(assoc(calclist,"POWER"))) t;
neuper@38032
   252
val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@37906
   253
"4 ^ 2 = 16";
neuper@37906
   254
wneuper@59188
   255
 val t = (Thm.term_of o the o (parse thy)) "((1 + 2) * 4 / 3) ^^^ 2";
wneuper@59255
   256
 val SOME (thmID,thm) = adhoc_thm thy (the(assoc(calclist,"PLUS"))) t;
neuper@37906
   257
"1 + 2 = 3";
neuper@38032
   258
 val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@38033
   259
 term2str t;
neuper@37906
   260
"(3 * 4 / 3) ^^^ 2";
wneuper@59255
   261
 val SOME (thmID,thm) = adhoc_thm thy (the(assoc(calclist,"TIMES")))t;
neuper@37906
   262
"3 * 4 = 12";
neuper@38032
   263
 val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@38033
   264
 term2str t;
neuper@37906
   265
"(12 / 3) ^^^ 2";
wneuper@59255
   266
 val SOME (thmID,thm) =adhoc_thm thy(the(assoc(calclist,"DIVIDE")))t;
neuper@37906
   267
"12 / 3 = 4";
neuper@38032
   268
 val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@38033
   269
 term2str t;
neuper@37906
   270
"4 ^^^ 2";
wneuper@59255
   271
 val SOME (thmID,thm) = adhoc_thm thy(the(assoc(calclist,"POWER")))t;
neuper@37906
   272
"4 ^^^ 2 = 16";
neuper@38032
   273
 val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@38033
   274
 term2str t;
neuper@37906
   275
"16";
neuper@38031
   276
 if it <> "16" then error "calculate.sml: new behaviour in calculate_"
neuper@37906
   277
 else ();
neuper@37906
   278
neuper@37906
   279
(*13.9.02 *** calc: operator = pow not defined*)
wneuper@59188
   280
  val t = (Thm.term_of o the o (parse thy)) "3^^^2";
neuper@38032
   281
  val SOME (thmID,thm) = 
wneuper@59255
   282
      adhoc_thm thy (the(assoc(calclist,"POWER"))) t;
neuper@37906
   283
(*** calc: operator = pow not defined*)
neuper@37906
   284
neuper@38033
   285
  val (op_, eval_fn) = the (assoc(calclist,"POWER"));
neuper@37906
   286
  (*
neuper@37906
   287
val op_ = "Atools.pow" : string
neuper@37906
   288
val eval_fn = fn : string -> term -> theory -> (string * term) option*)
neuper@37906
   289
neuper@38032
   290
  val SOME (thmid,t') = get_pair thy op_ eval_fn t;
neuper@37906
   291
(*** calc: operator = pow not defined*)
neuper@37906
   292
neuper@38032
   293
  val SOME (id,t') = eval_fn op_ t thy;
neuper@37906
   294
(*** calc: operator = pow not defined*)
neuper@37906
   295
neuper@37906
   296
  val (thmid, (Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2))) = (op_, t);
neuper@38032
   297
  val SOME (id,t') = eval_binop thmid op_ t thy;
neuper@37906
   298
(*** calc: operator = pow not defined*)
neuper@37906
   299
akargl@42188
   300
neuper@37906
   301
"----------- get_pair with 3 args --------------------------------";
neuper@37906
   302
"----------- get_pair with 3 args --------------------------------";
neuper@37906
   303
"----------- get_pair with 3 args --------------------------------";
neuper@37906
   304
val (thy, op_, ef, arg) =
neuper@37906
   305
    (thy, "EqSystem.occur'_exactly'_in", 
wneuper@59361
   306
     assoc_calc' (Thy_Info_get_theory "EqSystem") "occur_exactly_in" |> snd |> snd,
neuper@37906
   307
     str2term
akargl@42188
   308
      "[] from [c, c_2, c_3, c_4] occur_exactly_in -1 * (q_0 * L ^^^ 2) / 2"
neuper@37906
   309
      );
neuper@38032
   310
val SOME (str, simpl) = get_pair thy op_ ef arg;
neuper@37906
   311
if str = 
akargl@42188
   312
"[] from [c, c_2, c_3, c_4] occur_exactly_in -1 * (q_0 * L ^^^ 2) / 2 = True"
neuper@38031
   313
then () else error "calculate.sml get_pair with 3 args:occur_exactly_in";
neuper@37906
   314
neuper@37906
   315
neuper@38032
   316
"----------- calculate (2 * x is_const) -----------------";
neuper@38032
   317
"----------- calculate (2 * x is_const) -----------------";
neuper@38032
   318
"----------- calculate (2 * x is_const) -----------------";
neuper@37906
   319
val t = str2term "2 * x is_const";
akargl@42188
   320
val SOME (str, t') = eval_const "" "" t @{theory Test};
neuper@37906
   321
term2str t';
neuper@37906
   322
"(2 * x is_const) = False";
neuper@37906
   323
akargl@42188
   324
val SOME (t',_) = rewrite_set_ @{theory Test} false tval_rls t;
neuper@37906
   325
term2str t';
neuper@41928
   326
"HOL.False";
wneuper@59387
   327
wneuper@59387
   328
"----------- fun get_pair: examples ------------------------------------------------------------";
wneuper@59387
   329
"----------- fun get_pair: examples ------------------------------------------------------------";
wneuper@59387
   330
"----------- fun get_pair: examples ------------------------------------------------------------";
wneuper@59387
   331
 (*
wneuper@59387
   332
>  val t = (Thm.term_of o the o (parse thy)) "#3 + #4";
wneuper@59387
   333
>  val eval_fn = the (assoc (!eval_list, "Groups.plus_class.plus"));
wneuper@59387
   334
>  val (SOME (id,t')) = get_pair thy "Groups.plus_class.plus" eval_fn t;
wneuper@59387
   335
>  term2str t';
wneuper@59387
   336
>  atomty t';
wneuper@59387
   337
> 
wneuper@59387
   338
>  val t = (Thm.term_of o the o (parse thy)) "(a + #3) + #4";
wneuper@59387
   339
>  val (SOME (id,t')) = get_pair thy "Groups.plus_class.plus" eval_fn t;
wneuper@59387
   340
>  term2str t';
wneuper@59387
   341
> 
wneuper@59387
   342
>  val t = (Thm.term_of o the o (parse thy)) "#3 + (#4 + (a::real))";
wneuper@59387
   343
>  val (SOME (id,t')) = get_pair thy "Groups.plus_class.plus" eval_fn t;
wneuper@59387
   344
>  term2str t';
wneuper@59387
   345
> 
wneuper@59387
   346
>  val t = (Thm.term_of o the o (parse thy)) "x = #5 * (#3 + (#4 + a))";
wneuper@59387
   347
>  atomty t;
wneuper@59387
   348
>  val (SOME (id,t')) = get_pair thy "Groups.plus_class.plus" eval_fn t;
wneuper@59387
   349
>  term2str t';
wneuper@59387
   350
>  val it = "#3 + (#4 + a) = #7 + a" : string
wneuper@59387
   351
>
wneuper@59387
   352
>
wneuper@59387
   353
>  val t = (Thm.term_of o the o (parse thy)) "#-4//#-2";
wneuper@59387
   354
>  val eval_fn = the (assoc (!eval_list, "cancel"));
wneuper@59387
   355
>  val (SOME (id,t')) = get_pair thy "cancel" eval_fn t;
wneuper@59387
   356
>  term2str t';
wneuper@59387
   357
> 
wneuper@59387
   358
>  val t = (Thm.term_of o the o (parse thy)) "#2^^^#3";
wneuper@59387
   359
>  eval_binop "xxx" "pow" t thy;
wneuper@59387
   360
>  val eval_fn = (eval_binop "xxx")
wneuper@59387
   361
>		 : string -> term -> theory -> (string * term) option;
wneuper@59387
   362
>  val SOME (id,t') = get_pair thy "pow" eval_fn t;
wneuper@59387
   363
>  term2str t';
wneuper@59387
   364
>  val eval_fn = the (assoc (!eval_list, "pow"));
wneuper@59387
   365
>  val (SOME (id,t')) = get_pair thy "pow" eval_fn t;
wneuper@59387
   366
>  term2str t';
wneuper@59387
   367
> 
wneuper@59387
   368
>  val t = (Thm.term_of o the o (parse thy)) "x = #0 + #-1 * #-4";
wneuper@59387
   369
>  val eval_fn = the (assoc (!eval_list, "Groups.times_class.times"));
wneuper@59387
   370
>  val (SOME (id,t')) = get_pair thy "Groups.times_class.times" eval_fn t;
wneuper@59387
   371
>  term2str t';
wneuper@59387
   372
> 
wneuper@59387
   373
>  val t = (Thm.term_of o the o (parse thy)) "#0 < #4";
wneuper@59387
   374
>  val eval_fn = the (assoc (!eval_list, "Orderings.ord_class.less"));
wneuper@59387
   375
>  val (SOME (id,t')) = get_pair thy "Orderings.ord_class.less" eval_fn t;
wneuper@59387
   376
>  term2str t';
wneuper@59387
   377
>  val t = (Thm.term_of o the o (parse thy)) "#0 < #-4";
wneuper@59387
   378
>  val (SOME (id,t')) = get_pair thy "Orderings.ord_class.less" eval_fn t;
wneuper@59387
   379
>  term2str t';
wneuper@59387
   380
> 
wneuper@59387
   381
>  val t = (Thm.term_of o the o (parse thy)) "#3 is_const";
wneuper@59387
   382
>  val eval_fn = the (assoc (!eval_list, "is'_const"));
wneuper@59387
   383
>  val (SOME (id,t')) = get_pair thy "is'_const" eval_fn t;
wneuper@59387
   384
>  term2str t';
wneuper@59387
   385
>  val t = (Thm.term_of o the o (parse thy)) "a is_const";
wneuper@59387
   386
>  val (SOME (id,t')) = get_pair thy "is'_const" eval_fn t;
wneuper@59387
   387
>  term2str t';
wneuper@59387
   388
> 
wneuper@59387
   389
>  val t = (Thm.term_of o the o (parse thy)) "#6//(#8::real)";
wneuper@59387
   390
>  val eval_fn = the (assoc (!eval_list, "cancel"));
wneuper@59387
   391
>  val (SOME (id,t')) = get_pair thy "cancel" eval_fn t;
wneuper@59387
   392
>  term2str t';
wneuper@59387
   393
> 
wneuper@59387
   394
>  val t = (Thm.term_of o the o (parse thy)) "sqrt #12";
wneuper@59387
   395
>  val eval_fn = the (assoc (!eval_list, "SqRoot.sqrt"));
wneuper@59387
   396
>  val (SOME (id,t')) = get_pair thy "SqRoot.sqrt" eval_fn t;
wneuper@59387
   397
>  term2str t';
wneuper@59387
   398
>  val it = "sqrt #12 = #2 * sqrt #3 " : string
wneuper@59387
   399
>
wneuper@59387
   400
>  val t = (Thm.term_of o the o (parse thy)) "sqrt #9";
wneuper@59387
   401
>  val (SOME (id,t')) = get_pair thy "SqRoot.sqrt" eval_fn t;
wneuper@59387
   402
>  term2str t';
wneuper@59387
   403
>
wneuper@59387
   404
>  val t = (Thm.term_of o the o (parse thy)) "Nth #2 [#11,#22,#33]";
wneuper@59387
   405
>  val eval_fn = the (assoc (!eval_list, "Tools.Nth"));
wneuper@59387
   406
>  val (SOME (id,t')) = get_pair thy "Tools.Nth" eval_fn t;
wneuper@59387
   407
>  term2str t';
wneuper@59387
   408
*)
wneuper@59387
   409
"----------- fun adhoc_thm: examples -----------------------------------------------------------";
wneuper@59387
   410
"----------- fun adhoc_thm: examples -----------------------------------------------------------";
wneuper@59387
   411
"----------- fun adhoc_thm: examples -----------------------------------------------------------";
wneuper@59387
   412
(*
wneuper@59387
   413
> val ct = (the o (parse thy)) "#9 is_const";
wneuper@59387
   414
> adhoc_thm thy ("is'_const",the (assoc(!eval_list,"is'_const"))) ct;
wneuper@59387
   415
val it = SOME ("is_const9_","(is_const 9 ) = True  [(is_const 9 ) = True]")
wneuper@59387
   416
wneuper@59387
   417
> val ct = (the o (parse thy)) "sqrt #9";
wneuper@59387
   418
> adhoc_thm thy ("sqrt",the (assoc(!eval_list,"sqrt"))) ct;
wneuper@59387
   419
val it = SOME ("sqrt_9_","sqrt 9  = 3  [sqrt 9  = 3]") : (string * thm) option
wneuper@59387
   420
wneuper@59387
   421
> val ct = (the o (parse thy)) "#4<#4";
wneuper@59387
   422
> adhoc_thm thy ("Orderings.ord_class.less",the (assoc(!eval_list,"Orderings.ord_class.less"))) ct;fun is_no str = (hd o Symbol.explode) str = "#";
wneuper@59387
   423
wneuper@59387
   424
val it = SOME ("less_5_4","(5 < 4) = False  [(5 < 4) = False]")
wneuper@59387
   425
wneuper@59387
   426
> val ct = (the o (parse thy)) "a<#4";
wneuper@59387
   427
> adhoc_thm thy ("Orderings.ord_class.less",the (assoc(!eval_list,"Orderings.ord_class.less"))) ct;
wneuper@59387
   428
val it = NONE : (string * thm) option
wneuper@59387
   429
wneuper@59387
   430
> val ct = (the o (parse thy)) "#5<=#4";
wneuper@59387
   431
> adhoc_thm thy ("Orderings.ord_class.less_eq",the (assoc(!eval_list,"Orderings.ord_class.less_eq"))) ct;
wneuper@59387
   432
val it = SOME ("less_equal_5_4","(5 <= 4) = False  [(5 <= 4) = False]")
wneuper@59387
   433
wneuper@59387
   434
-------------------------------------------------------------------6.8.02:
wneuper@59387
   435
 val thy = SqRoot.thy;
wneuper@59387
   436
 val t = (Thm.term_of o the o (parse thy)) "1+2";
wneuper@59387
   437
 adhoc_thm thy (the(assoc(!calc_list,"PLUS"))) t;
wneuper@59387
   438
 val it = SOME ("add_3_4","3 + 4 = 7  [3 + 4 = 7]") : (string * thm) option
wneuper@59387
   439
-------------------------------------------------------------------6.8.02:
wneuper@59387
   440
 val t = (Thm.term_of o the o (parse thy)) "-1";
wneuper@59387
   441
 atomty t;
wneuper@59387
   442
 val t = (Thm.term_of o the o (parse thy)) "0";
wneuper@59387
   443
 atomty t;
wneuper@59387
   444
 val t = (Thm.term_of o the o (parse thy)) "1";
wneuper@59387
   445
 atomty t;
wneuper@59387
   446
 val t = (Thm.term_of o the o (parse thy)) "2";
wneuper@59387
   447
 atomty t;
wneuper@59387
   448
 val t = (Thm.term_of o the o (parse thy)) "999999999";
wneuper@59387
   449
 atomty t;
wneuper@59387
   450
-------------------------------------------------------------------6.8.02:
wneuper@59387
   451
wneuper@59387
   452
> val ct = (the o (parse thy)) "a+#3+#4";
wneuper@59387
   453
> adhoc_thm thy ("Groups.plus_class.plus",the (assoc(!eval_list,"Groups.plus_class.plus"))) ct;
wneuper@59387
   454
val it = SOME ("add_3_4","a + 3 + 4 = a + 7  [a + 3 + 4 = a + 7]")
wneuper@59387
   455
 
wneuper@59387
   456
> val ct = (the o (parse thy)) "#3+(#4+a)";
wneuper@59387
   457
> adhoc_thm thy ("Groups.plus_class.plus",the (assoc(!eval_list,"Groups.plus_class.plus"))) ct;
wneuper@59387
   458
val it = SOME ("add_3_4","3 + (4 + a) = 7 + a  [3 + (4 + a) = 7 + a]")
wneuper@59387
   459
 
wneuper@59387
   460
> val ct = (the o (parse thy)) "a+(#3+#4)+#5";
wneuper@59387
   461
> adhoc_thm thy ("Groups.plus_class.plus",the (assoc(!eval_list,"Groups.plus_class.plus"))) ct;
wneuper@59387
   462
val it = SOME ("add_3_4","3 + 4 = 7  [3 + 4 = 7]") : (string * thm) option
wneuper@59387
   463
wneuper@59387
   464
> val ct = (the o (parse thy)) "#3*(#4*a)";
wneuper@59387
   465
> adhoc_thm thy ("Groups.times_class.times",the (assoc(!eval_list,"Groups.times_class.times"))) ct;
wneuper@59387
   466
val it = SOME ("mult_3_4","3 * (4 * a) = 12 * a  [3 * (4 * a) = 12 * a]")
wneuper@59387
   467
wneuper@59387
   468
> val ct = (the o (parse thy)) "#3 + #4^^^#2 + #5";
wneuper@59387
   469
> adhoc_thm thy ("pow",the (assoc(!eval_list,"pow"))) ct;
wneuper@59387
   470
val it = SOME ("4_(+2)","4 ^ 2 = 16  [4 ^ 2 = 16]") : (string * thm) option
wneuper@59387
   471
wneuper@59387
   472
> val ct = (the o (parse thy)) "#-4//#-2";
wneuper@59387
   473
> adhoc_thm thy ("cancel",the (assoc(!eval_list,"cancel"))) ct;
wneuper@59387
   474
val it = SOME ("cancel_(-4)_(-2)","(-4) // (-2) = (+2)  [(-4) // (-2) = (+2)]")
wneuper@59387
   475
wneuper@59387
   476
> val ct = (the o (parse thy)) "#6//#-8";
wneuper@59387
   477
> adhoc_thm thy ("cancel",the (assoc(!eval_list,"cancel"))) ct;
wneuper@59387
   478
val it = SOME ("cancel_6_(-8)","6 // (-8) = (-3) // 4  [6 // (-8) = (-3) // 4]")
wneuper@59387
   479
wneuper@59387
   480
*) 
wneuper@59387
   481
wneuper@59387
   482
(*
wneuper@59387
   483
--------------------------
wneuper@59387
   484
> val ct = (the o (parse thy)) "3 =!= 3";
wneuper@59387
   485
> val (thmid, thm) = the (adhoc_thm thy "Atools.ident" ct);
wneuper@59387
   486
val thm = "(3 =!= 3) = True  [(3 =!= 3) = True]" : thm
wneuper@59387
   487
wneuper@59387
   488
> val ct = (the o (parse thy)) "~ (3 =!= 3)";
wneuper@59387
   489
> val (thmid, thm) = the (adhoc_thm thy "Atools.ident" ct);
wneuper@59387
   490
val thm = "(3 =!= 3) = True  [(3 =!= 3) = True]" : thm
wneuper@59387
   491
wneuper@59387
   492
> val ct = (the o (parse thy)) "3 =!= 4";
wneuper@59387
   493
> val (thmid, thm) = the (adhoc_thm thy "Atools.ident" ct);
wneuper@59387
   494
val thm = "(3 =!= 4) = False  [(3 =!= 4) = False]" : thm
wneuper@59387
   495
wneuper@59387
   496
> val ct = (the o (parse thy)) "( 4 + (4 * x + x ^ 2) =!= (+0))";
wneuper@59387
   497
> val (thmid, thm) = the (adhoc_thm thy "Atools.ident" ct);
wneuper@59387
   498
  "(4 + (4 * x + x ^ 2) =!= (+0)) = False"
wneuper@59387
   499
wneuper@59387
   500
> val ct = (the o (parse thy)) "~ ( 4 + (4 * x + x ^ 2) =!= (+0))";
wneuper@59387
   501
> val (thmid, thm) = the (adhoc_thm thy "Atools.ident" ct);
wneuper@59387
   502
  "(4 + (4 * x + x ^ 2) =!= (+0)) = False"
wneuper@59387
   503
wneuper@59387
   504
> val ct = (the o (parse thy)) "~ ( 4 + (4 * x + x ^ 2) =!= (+0))";
wneuper@59387
   505
> val rls = eval_rls;
wneuper@59387
   506
> val (ct,_) = the (rewrite_set_ thy false rls ct);
wneuper@59387
   507
val ct = "HOL.True" : cterm
wneuper@59387
   508
--------------------------
wneuper@59387
   509
*)
wneuper@59387
   510