test/Tools/isac/ProgLang/calculate.sml
author Walther Neuper <walther.neuper@jku.at>
Wed, 15 Apr 2020 10:07:43 +0200
changeset 59876 eff0b9fc6caa
parent 59875 995177b6d786
child 59900 4e6fc3336336
permissions -rw-r--r--
use "ThmC" for renaming identifiers
wneuper@59546
     1
(* Title:  "ProgLang/calculate.sml"
wneuper@59546
     2
           test calculation of values for function constants
neuper@38022
     3
   Author: Walther Neuper 2000
neuper@38022
     4
   (c) copyright due to lincense terms.
neuper@37906
     5
*)
neuper@37906
     6
neuper@38022
     7
"--------------------------------------------------------";
neuper@38022
     8
"table of contents --------------------------------------";
neuper@38022
     9
"--------------------------------------------------------";
neuper@55366
    10
"-calculate.thy: provides 'setup' -----------------------";
neuper@41924
    11
"----------- fun norm -----------------------------------";
wneuper@59255
    12
"----------- check return value of adhoc_thm  ----";
wneuper@59411
    13
"----------- fun calculate_ --------------------------------------------------------------------";
wneuper@59411
    14
"----------- calculate from Prog --------------------------------- -----------------------------";
neuper@55366
    15
"----------- calculate from script --requires 'setup'----";
neuper@38032
    16
"----------- calculate check test-root-equ --------------";
wneuper@59253
    17
"----------- check calcul,ate bottom up -----------------";
walther@59603
    18
"----------- Prog_Expr.pow Power.power_class.power ---------";
neuper@41934
    19
" ================= calculate.sml: calculate_ 2002 ======";
neuper@38032
    20
"----------- get_pair with 3 args -----------------------";
neuper@38032
    21
"----------- calculate (2 * x is_const) -----------------";
wneuper@59387
    22
"----------- fun get_pair: examples ------------------------------------------------------------";
wneuper@59387
    23
"----------- fun adhoc_thm: examples -----------------------------------------------------------";
wneuper@59403
    24
"----------- fun power -------------------------------------------------------------------------";
wneuper@59403
    25
"----------- fun divisors ----------------------------------------------------------------------";
wneuper@59403
    26
"----------- fun doubles, fun squfact ----------------------------------------------------------";
neuper@38022
    27
"--------------------------------------------------------";
neuper@38022
    28
"--------------------------------------------------------";
neuper@38022
    29
"--------------------------------------------------------";
neuper@37906
    30
wneuper@59255
    31
"----------- check return value of adhoc_thm  ----";
wneuper@59255
    32
"----------- check return value of adhoc_thm  ----";
wneuper@59255
    33
"----------- check return value of adhoc_thm  ----";
neuper@41924
    34
val thy = @{theory "Poly"};
s1210629013@52153
    35
val cal = snd (assoc_calc' thy "is_polyexp");
neuper@38022
    36
val t = @{term "(x / x) is_polyexp"};
wneuper@59255
    37
val SOME (thmID, thm) = adhoc_thm thy cal t;
wneuper@59188
    38
(HOLogic.dest_Trueprop (Thm.prop_of thm); writeln "all thms wrapped by Trueprop")
neuper@38022
    39
handle TERM _ => 
wneuper@59255
    40
       error "calculate.sml: adhoc_thm must return Trueprop";
neuper@38022
    41
wneuper@59411
    42
"----------- fun calculate_ --------------------------------------------------------------------";
wneuper@59411
    43
"----------- fun calculate_ --------------------------------------------------------------------";
wneuper@59411
    44
"----------- fun calculate_ --------------------------------------------------------------------";
wneuper@59411
    45
(* fun rewrite__set_ \<longrightarrow> fun rew_once works the same way *)
wneuper@59411
    46
val t = str2term "((1+2)*4/3)^^^2";
wneuper@59411
    47
val thy = @{theory};
walther@59854
    48
val times =  ("Groups.times_class.times", eval_binop "#mult_") : string * Exec_Def.eval_fn;
walther@59854
    49
val plus =   ("Groups.plus_class.plus",eval_binop "#add_") : string * Exec_Def.eval_fn;
walther@59854
    50
val divide = ("Rings.divide_class.divide"  ,eval_cancel "#divide_e") : string * Exec_Def.eval_fn;
walther@59854
    51
val pow =    ("Prog_Expr.pow"  ,eval_binop "#power_") : string * Exec_Def.eval_fn;
wneuper@59411
    52
wneuper@59411
    53
"~~~~~ fun calculate_, args:"; val (thy, isa_fn, t) = (thy, plus, t);
wneuper@59411
    54
val SOME ("#: 1 + 2 = 3", adh_thm) = adhoc_thm @{theory} isa_fn t;
walther@59852
    55
val SOME (t', []) = rewrite__ thy 0 [] e_rew_ord Rule_Set.empty true adh_thm t;
walther@59868
    56
if UnparseC.term t' = "(3 * 4 / 3) ^^^ 2" then () else error "calculate_  1 + 2 = 3  changed";
wneuper@59411
    57
wneuper@59411
    58
"~~~~~ fun calculate_, args:"; val (thy, isa_fn, t) = (thy, times, t');
wneuper@59411
    59
val SOME ("#: 3 * 4 = 12", adh_thm) = adhoc_thm @{theory} isa_fn t';
walther@59852
    60
val SOME (t'', []) = rewrite__ thy 0 [] e_rew_ord Rule_Set.empty true adh_thm t;
walther@59868
    61
if UnparseC.term t'' = "(12 / 3) ^^^ 2" then () else error "calculate_  3 * 4 = 12  changed";
wneuper@59411
    62
wneuper@59411
    63
"~~~~~ fun calculate_, args:"; val (thy, isa_fn, t) = (thy, divide, t'');
wneuper@59411
    64
val SOME ("#divide_e12_3", adh_thm) = adhoc_thm @{theory} isa_fn t;
walther@59852
    65
val SOME (t''', []) = rewrite__ thy 0 [] e_rew_ord Rule_Set.empty true adh_thm t;
walther@59868
    66
if UnparseC.term t''' = "4 ^^^ 2" then () else error "calculate_  12 / 3 = 4  changed";
wneuper@59411
    67
wneuper@59411
    68
"~~~~~ fun calculate_, args:"; val (thy, isa_fn, t) = (thy, pow, t''');
wneuper@59411
    69
val SOME ("#: 4 ^^^ 2 = 16", adh_thm) = adhoc_thm @{theory} isa_fn t;
walther@59852
    70
val SOME (t'''', []) = rewrite__ thy 0 [] e_rew_ord Rule_Set.empty true adh_thm t;
walther@59868
    71
if UnparseC.term t'''' = "16" then () else error "calculate_  12 / 3 = 4  changed";
wneuper@59411
    72
wneuper@59411
    73
"----------- calculate from Prog --------------------------------- -----------------------------";
wneuper@59411
    74
"----------- calculate from Prog --------------------------------- -----------------------------";
wneuper@59411
    75
"----------- calculate from Prog --------------------------------- -----------------------------";
neuper@41924
    76
val thy = @{theory "Test"};
neuper@37906
    77
val fmz = ["realTestGiven (((1+2)*4/3)^^^2)","realTestFind s"];
neuper@37906
    78
val (dI',pI',mI') =
neuper@38035
    79
  ("Test",["calculate","test"],["Test","test_calculate"]);
neuper@38035
    80
neuper@37906
    81
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
    82
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
    83
(*nxt =("Add_Given",Add_Given "realTestGiven (((#1 + #2) * #4 // #3) ^^^#2)")*)
neuper@37906
    84
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
    85
(*nxt = ("Add_Find",Add_Find "realTestFind s") : string * tac*)
neuper@37906
    86
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38035
    87
(*nxt = ("Specify_Theory",Specify_Theory "Test") : string * tac*)
neuper@37906
    88
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
    89
(*nxt = ("Specify_Problem",Specify_Problem ["calculate","test"])*)
neuper@37906
    90
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38035
    91
(*nxt = ("Specify_Method",Specify_Method ("Test","test_calculate"))*)
neuper@37906
    92
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38035
    93
(*nxt = ("Apply_Method",Apply_Method ("Test","test_calculate"))*)
neuper@37906
    94
walther@59713
    95
(*[1], Frm*)val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Calculate",Calculate "PLUS")*)
walther@59713
    96
(*[1], Res*)val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Calculate",Calculate "TIMES")*)
walther@59713
    97
(*[2], Res*)val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Calculate",Calculate "DIVIDE")*)
walther@59713
    98
(*[3], Res*)val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Calculate",Calculate "POWER")*)
walther@59713
    99
(*[4], Res*)val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Check_Postcond",Check_Postcond ["calculate","test"])*)
walther@59713
   100
(*[], Res*)val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("End_Proof'",End_Proof')*)
wneuper@59267
   101
case f of FormKF "16" => () | _ =>
wneuper@59253
   102
error "calculate.sml: script test_calculate changed behaviour";
neuper@37906
   103
neuper@37906
   104
neuper@38032
   105
"----------- calculate check test-root-equ --------------";
neuper@38032
   106
"----------- calculate check test-root-equ --------------";
neuper@38032
   107
"----------- calculate check test-root-equ --------------";
neuper@37906
   108
(*(1): 2nd Test_simplify didn't work:
neuper@37906
   109
val ct =
neuper@37906
   110
  "sqrt (x ^^^ 2 + -3 * x) = (-3 + 2 * x + -1 * (9 + 4 * x)) / (-1 * 2)"
neuper@37906
   111
> val rls = ("Test_simplify");
neuper@37906
   112
> val (ct,_) = the (rewrite_set thy' ("tval_rls") false rls ct);
neuper@37906
   113
val ct = "sqrt (x ^^^ 2 + -3 * x) =
neuper@37906
   114
(-9) / (-2) + (-3 / (-2) + (x * ((-4) / (-2)) + x * (2 / (-2))))";
neuper@37906
   115
ie. cancel does not work properly
neuper@37906
   116
*)
wneuper@59382
   117
 val thy = @{theory "Test"};
walther@59686
   118
 val op_ = the (LibraryC.assoc (KEStore_Elems.get_calcs @{theory}, "DIVIDE"));
walther@59875
   119
 val ct = ThmC_Def.num_to_Free @{term
wneuper@59382
   120
   "sqrt (x ^^^ 2 + -3 * x) = (-9) / (-2) + (-3 / (-2) + (x * ((-4) / (-2)) + x * (2 / (-2))))"};
wneuper@59382
   121
case calculate_ thy op_ ct of
wneuper@59382
   122
  SOME _ => ()
wneuper@59382
   123
| NONE => error "calculate_ test-root-equ changed";
neuper@37906
   124
(*
neuper@37906
   125
           sqrt (x ^^^ 2 + -3 * x) =\
neuper@37906
   126
 \(-9) / (-2) + (-3 / (-2) + (x * ((-4) / (-2)) + x * (2 / (-2))))
neuper@37906
   127
............... does not work *)
neuper@37906
   128
neuper@37906
   129
(*--------------(2): does divide work in Test_simplify ?: ------*)
akargl@42188
   130
 val thy = @{theory Test};
wneuper@59188
   131
 val t = (Thm.term_of o the o (parse thy)) "6 / 2";
neuper@37906
   132
 val rls = Test_simplify;
neuper@37906
   133
 val (t,_) = the (rewrite_set_ thy false rls t);
neuper@55279
   134
(*val t = Free ("3","Real.real") : term*)
neuper@37906
   135
neuper@37906
   136
(*--------------(3): is_const works ?: -------------------------------------*)
wneuper@59188
   137
 val t = (Thm.term_of o the o (parse @{theory Test})) "2 is_const";
neuper@37906
   138
 atomty t;
akargl@42188
   139
 rewrite_set_ @{theory Test} false tval_rls t;
neuper@41928
   140
(*val it = SOME (Const ("HOL.True","bool"),[]) ... works*)
neuper@37906
   141
neuper@37906
   142
 val t = str2term "2 * x is_const";
wneuper@59592
   143
 val SOME (str,t') = eval_const "" "" t (@{theory "Isac_Knowledge"});
walther@59868
   144
 UnparseC.term t';
neuper@37906
   145
 
neuper@37906
   146
neuper@38032
   147
"----------- check calculate bottom up ------------------";
neuper@38032
   148
"----------- check calculate bottom up ------------------";
neuper@38032
   149
"----------- check calculate bottom up ------------------";
neuper@37906
   150
(*-------------- eval_cancel works: *)
neuper@52070
   151
 trace_rewrite:=false;
akargl@42188
   152
 val thy = @{theory Test};
wneuper@59384
   153
 val rls = Test_simplify;
wneuper@59188
   154
 val t = (Thm.term_of o the o (parse thy)) "(-4) / 2";
akargl@42188
   155
wneuper@59360
   156
val SOME (_, t) = eval_cancel "xxx" "Rings.divide_class.divide" t thy;
akargl@42188
   157
neuper@37906
   158
(*--------------(5): reproduce (1) with simpler term: ------------*)
wneuper@59384
   159
 val t = (Thm.term_of o the o (parse thy)) "(3+5)/2";
wneuper@59384
   160
case rewrite_set_ thy false rls t of
wneuper@59384
   161
  SOME (Free ("4", _), []) => ()
wneuper@59384
   162
| _ => error "rewrite_set_ (3+5)/2 changed";
neuper@37906
   163
wneuper@59384
   164
 val t = (Thm.term_of o the o (parse thy)) "(3+1+2*x)/2";
wneuper@59384
   165
case rewrite_set_ thy false rls t of
wneuper@59384
   166
  SOME (Const ("Groups.plus_class.plus", _) $ Free ("2", _) $ Free ("x", _), []) => ()
wneuper@59384
   167
| _ => error "rewrite_set_ (3+1+2*x)/2 changed";
neuper@37906
   168
neuper@52070
   169
 trace_rewrite:=false; (*=true3.6.03*)
akargl@42218
   170
neuper@37906
   171
(*--- trace_rewrite before correction of ... --------------------
neuper@37906
   172
 val ct = "(-3 + 2 * x + -1) / 2";
neuper@37906
   173
 val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   174
:
neuper@37906
   175
### trying thm 'root_ge0_2'
neuper@37906
   176
### rewrite_set_: x + (-1 + -3) / 2
neuper@37906
   177
### trying thm 'radd_real_const_eq'
neuper@37906
   178
### trying thm 'radd_real_const'
neuper@37906
   179
### rewrite_set_: x + (-4) / 2
neuper@37906
   180
### trying thm 'rcollect_right'
neuper@37906
   181
:
neuper@37906
   182
"x + (-4) / 2"
neuper@37906
   183
-------------------------------------while before Isabelle20002:
neuper@37906
   184
 val ct = "(#-3 + #2 * x + #-1) // #2";
neuper@37906
   185
 val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   186
:
neuper@37906
   187
### trying thm 'root_ge0_2'
neuper@37906
   188
### rewrite_set_: x + (#-1 + #-3) // #2
neuper@37906
   189
### trying thm 'radd_real_const_eq'
neuper@37906
   190
### trying thm 'radd_real_const'
neuper@37906
   191
### rewrite_set_: x + #-4 // #2
neuper@37906
   192
### rewrite_set_: x + #-2
neuper@37906
   193
### trying thm 'rcollect_right'
neuper@37906
   194
:
neuper@37906
   195
"#-2 + x"
neuper@37906
   196
-----------------------------------------------------------------*)
neuper@37906
   197
neuper@37906
   198
neuper@37906
   199
(*===================*)
neuper@52070
   200
 trace_rewrite:=false; (*WN130722: =true stopped Test_Isac.thy*)
wneuper@59384
   201
 val t = (Thm.term_of o the o (parse thy))  "x + (-1 + -3) / 2";
wneuper@59384
   202
val SOME (res, []) = rewrite_set_ thy false rls t;
walther@59868
   203
if UnparseC.term res = "-2 + x" then () else error "rewrite_set_  x + (-1 + -3) / 2  changed";
neuper@37906
   204
"x + (-4) / 2";						
neuper@37906
   205
(*
neuper@37906
   206
### trying calc. 'cancel'
neuper@37906
   207
@@@ get_pair: binop, t = x + (-4) / 2
neuper@37906
   208
@@@ get_pair: t else
neuper@38032
   209
@@@ get_pair: t else -> NONE
neuper@37906
   210
@@@ get_pair: binop, t = (-4) / 2
neuper@37906
   211
@@@ get_pair: then 1
neuper@38032
   212
@@@ get_pair: t -> NONE
neuper@38032
   213
@@@ get_pair: t1 -> NONE
wneuper@59255
   214
@@@ adhoc_thm': NONE
neuper@37906
   215
### trying calc. 'pow'
neuper@37906
   216
*)
neuper@37906
   217
neuper@52070
   218
 trace_rewrite:=false; (*WN130722: =true stopped Test_Isac.thy*)
neuper@37906
   219
walther@59603
   220
"----------- Prog_Expr.pow Power.power_class.power ---------";
walther@59603
   221
"----------- Prog_Expr.pow Power.power_class.power ---------";
walther@59603
   222
"----------- Prog_Expr.pow Power.power_class.power ---------";
wneuper@59188
   223
val t = (Thm.term_of o the o (parseold thy)) "1 ^ aaa";
neuper@42223
   224
atomty t;
neuper@37906
   225
(*** -------------
neuper@37906
   226
*** Const ( Nat.power, ['a, nat] => 'a)
neuper@37906
   227
*** . Free ( 1, 'a)
neuper@37906
   228
*** . Free ( aaa, nat) *)
akargl@42218
   229
neuper@42223
   230
val t = str2term "1 ^^^ aaa";
neuper@42223
   231
atomty t;
neuper@42223
   232
(**** 
walther@59603
   233
*** Const (Prog_Expr.pow, real => real => real)
neuper@42223
   234
*** . Free (1, real)
neuper@42223
   235
*** . Free (aaa, real)
neuper@42223
   236
*** *);
neuper@37906
   237
neuper@37906
   238
" ================= calculate.sml: calculate_ 2002 =================== ";
neuper@37906
   239
" ================= calculate.sml: calculate_ 2002 =================== ";
neuper@37906
   240
" ================= calculate.sml: calculate_ 2002 =================== ";
neuper@37906
   241
akargl@42188
   242
val thy = @{theory Test};
wneuper@59188
   243
val t = (Thm.term_of o the o (parse thy)) "12 / 3";
walther@59686
   244
val SOME (thmID,thm) = adhoc_thm thy(the(LibraryC.assoc(KEStore_Elems.get_calcs @{theory},"DIVIDE")))t;
neuper@38032
   245
val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@37906
   246
"12 / 3 = 4";
akargl@42188
   247
val thy = @{theory Test};
wneuper@59188
   248
val t = (Thm.term_of o the o (parse thy)) "4 ^^^ 2";
walther@59686
   249
val SOME (thmID,thm) = adhoc_thm thy(the(LibraryC.assoc(KEStore_Elems.get_calcs @{theory},"POWER"))) t;
neuper@38032
   250
val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
neuper@37906
   251
"4 ^ 2 = 16";
neuper@37906
   252
wneuper@59188
   253
 val t = (Thm.term_of o the o (parse thy)) "((1 + 2) * 4 / 3) ^^^ 2";
walther@59686
   254
 val SOME (thmID,thm) = adhoc_thm thy (the(LibraryC.assoc(KEStore_Elems.get_calcs @{theory},"PLUS"))) t;
neuper@37906
   255
"1 + 2 = 3";
neuper@38032
   256
 val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
walther@59868
   257
 UnparseC.term t;
neuper@37906
   258
"(3 * 4 / 3) ^^^ 2";
walther@59686
   259
 val SOME (thmID,thm) = adhoc_thm thy (the(LibraryC.assoc(KEStore_Elems.get_calcs @{theory},"TIMES")))t;
neuper@37906
   260
"3 * 4 = 12";
neuper@38032
   261
 val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
walther@59868
   262
 UnparseC.term t;
neuper@37906
   263
"(12 / 3) ^^^ 2";
walther@59686
   264
 val SOME (thmID,thm) =adhoc_thm thy(the(LibraryC.assoc(KEStore_Elems.get_calcs @{theory},"DIVIDE")))t;
neuper@37906
   265
"12 / 3 = 4";
neuper@38032
   266
 val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
walther@59868
   267
 UnparseC.term t;
neuper@37906
   268
"4 ^^^ 2";
walther@59686
   269
 val SOME (thmID,thm) = adhoc_thm thy(the(LibraryC.assoc(KEStore_Elems.get_calcs @{theory},"POWER")))t;
neuper@37906
   270
"4 ^^^ 2 = 16";
neuper@38032
   271
 val SOME (t,_) = rewrite_ thy tless_true tval_rls true thm t;
walther@59868
   272
 UnparseC.term t;
neuper@37906
   273
"16";
neuper@38031
   274
 if it <> "16" then error "calculate.sml: new behaviour in calculate_"
neuper@37906
   275
 else ();
neuper@37906
   276
neuper@37906
   277
(*13.9.02 *** calc: operator = pow not defined*)
wneuper@59188
   278
  val t = (Thm.term_of o the o (parse thy)) "3^^^2";
neuper@38032
   279
  val SOME (thmID,thm) = 
walther@59686
   280
      adhoc_thm thy (the(LibraryC.assoc(KEStore_Elems.get_calcs @{theory},"POWER"))) t;
neuper@37906
   281
(*** calc: operator = pow not defined*)
neuper@37906
   282
walther@59686
   283
  val (op_, eval_fn) = the (LibraryC.assoc(KEStore_Elems.get_calcs @{theory},"POWER"));
neuper@37906
   284
  (*
walther@59603
   285
val op_ = "Prog_Expr.pow" : string
neuper@37906
   286
val eval_fn = fn : string -> term -> theory -> (string * term) option*)
neuper@37906
   287
neuper@38032
   288
  val SOME (thmid,t') = get_pair thy op_ eval_fn t;
neuper@37906
   289
(*** calc: operator = pow not defined*)
neuper@37906
   290
neuper@38032
   291
  val SOME (id,t') = eval_fn op_ t thy;
neuper@37906
   292
(*** calc: operator = pow not defined*)
neuper@37906
   293
neuper@37906
   294
  val (thmid, (Const (op0,t0) $ Free (n1,t1) $ Free(n2,t2))) = (op_, t);
neuper@38032
   295
  val SOME (id,t') = eval_binop thmid op_ t thy;
neuper@37906
   296
(*** calc: operator = pow not defined*)
neuper@37906
   297
akargl@42188
   298
neuper@37906
   299
"----------- get_pair with 3 args --------------------------------";
neuper@37906
   300
"----------- get_pair with 3 args --------------------------------";
neuper@37906
   301
"----------- get_pair with 3 args --------------------------------";
neuper@37906
   302
val (thy, op_, ef, arg) =
neuper@37906
   303
    (thy, "EqSystem.occur'_exactly'_in", 
wneuper@59462
   304
     assoc_calc' (@{theory "EqSystem"}) "occur_exactly_in" |> snd |> snd,
neuper@37906
   305
     str2term
akargl@42188
   306
      "[] from [c, c_2, c_3, c_4] occur_exactly_in -1 * (q_0 * L ^^^ 2) / 2"
neuper@37906
   307
      );
neuper@38032
   308
val SOME (str, simpl) = get_pair thy op_ ef arg;
neuper@37906
   309
if str = 
akargl@42188
   310
"[] from [c, c_2, c_3, c_4] occur_exactly_in -1 * (q_0 * L ^^^ 2) / 2 = True"
neuper@38031
   311
then () else error "calculate.sml get_pair with 3 args:occur_exactly_in";
neuper@37906
   312
neuper@37906
   313
neuper@38032
   314
"----------- calculate (2 * x is_const) -----------------";
neuper@38032
   315
"----------- calculate (2 * x is_const) -----------------";
neuper@38032
   316
"----------- calculate (2 * x is_const) -----------------";
neuper@37906
   317
val t = str2term "2 * x is_const";
akargl@42188
   318
val SOME (str, t') = eval_const "" "" t @{theory Test};
walther@59868
   319
UnparseC.term t';
neuper@37906
   320
"(2 * x is_const) = False";
neuper@37906
   321
akargl@42188
   322
val SOME (t',_) = rewrite_set_ @{theory Test} false tval_rls t;
walther@59868
   323
UnparseC.term t';
neuper@41928
   324
"HOL.False";
wneuper@59387
   325
wneuper@59387
   326
"----------- fun get_pair: examples ------------------------------------------------------------";
wneuper@59387
   327
"----------- fun get_pair: examples ------------------------------------------------------------";
wneuper@59387
   328
"----------- fun get_pair: examples ------------------------------------------------------------";
wneuper@59388
   329
val thy = @{theory};
walther@59686
   330
val SOME (isa_str, eval_fn) = LibraryC.assoc (KEStore_Elems.get_calcs @{theory}, "PLUS");
wneuper@59388
   331
wneuper@59388
   332
val t = (Thm.term_of o the o (parse thy)) "3 + 4";
wneuper@59388
   333
val SOME (str, term) = get_pair thy isa_str eval_fn t;
walther@59868
   334
if str =  "#: 3 + 4 = 7" andalso UnparseC.term term = "3 + 4 = 7"
wneuper@59388
   335
then () else error "get_pair  3 + 4  changed";
wneuper@59388
   336
wneuper@59388
   337
val t = (Thm.term_of o the o (parse thy)) "(a + 3) + 4";
wneuper@59388
   338
val SOME (str, term) = get_pair thy isa_str eval_fn t;
walther@59868
   339
if str =  "#: a + 3 + 4 = a + 7" andalso UnparseC.term term = "a + 3 + 4 = a + 7"
wneuper@59388
   340
then () else error "get_pair  (a + 3) + 4  changed";
wneuper@59388
   341
wneuper@59388
   342
val t = (Thm.term_of o the o (parse thy)) "(a + 3) + 4";
wneuper@59388
   343
val SOME (str, term) = get_pair thy isa_str eval_fn t;
walther@59868
   344
if str =  "#: a + 3 + 4 = a + 7" andalso UnparseC.term term = "a + 3 + 4 = a + 7"
wneuper@59388
   345
then () else error "get_pair  (a + 3) + 4  changed";
wneuper@59388
   346
wneuper@59388
   347
val t = (Thm.term_of o the o (parse thy)) "x = 5 * (3 + (4 + a))";
wneuper@59388
   348
val SOME (str, term) = get_pair thy isa_str eval_fn t;
walther@59868
   349
if str =  "#: 3 + (4 + a) = 7 + a" andalso UnparseC.term term = "3 + (4 + a) = 7 + a"
wneuper@59388
   350
then ((* !!! gets subterm !!!*)) else error "get_pair  x = 5 * (3 + (4 + a))  (subterm) changed";
wneuper@59388
   351
walther@59686
   352
val SOME (isa_str, eval_fn) = LibraryC.assoc (KEStore_Elems.get_calcs @{theory}, "DIVIDE");
wneuper@59388
   353
wneuper@59388
   354
val t = (Thm.term_of o the o (parse thy)) "-4 / -2";
wneuper@59388
   355
val SOME (str, term) = get_pair thy isa_str eval_fn t;
walther@59868
   356
if str =  "#divide_e-4_-2" andalso UnparseC.term term = "-4 / -2 = 2"
wneuper@59388
   357
then () else error "get_pair  -4 / -2   changed";
wneuper@59388
   358
walther@59686
   359
val SOME (isa_str, eval_fn) = LibraryC.assoc (KEStore_Elems.get_calcs @{theory}, "POWER");
wneuper@59388
   360
wneuper@59388
   361
val t = (Thm.term_of o the o (parse thy)) "2 ^^^ 3";
wneuper@59388
   362
val SOME (str, term) = get_pair thy isa_str eval_fn t;
walther@59868
   363
if str =  "#: 2 ^^^ 3 = 8" andalso UnparseC.term term = "2 ^^^ 3 = 8"
wneuper@59388
   364
then () else error "get_pair  2 ^^^ 3   changed";
wneuper@59388
   365
wneuper@59387
   366
"----------- fun adhoc_thm: examples -----------------------------------------------------------";
wneuper@59387
   367
"----------- fun adhoc_thm: examples -----------------------------------------------------------";
wneuper@59387
   368
"----------- fun adhoc_thm: examples -----------------------------------------------------------";
wneuper@59388
   369
(*--------------------------------------------------------------------vvvvvvvvvv*)
walther@59686
   370
val SOME (isa_str, eval_fn) = LibraryC.assoc (KEStore_Elems.get_calcs @{theory}, "is_const");
wneuper@59388
   371
val SOME t = parseNEW @{context} "9 is_const";
wneuper@59388
   372
val SOME (str, thm) = adhoc_thm thy (isa_str, eval_fn) t;
walther@59876
   373
if str = "#is_const_9_" andalso ThmC_Def.string_of_thm thm = "(9 is_const) = True"
wneuper@59388
   374
then () else error "adhoc_thm  9 is_const  changed";
wneuper@59387
   375
wneuper@59387
   376
wneuper@59388
   377
case assoc_calc thy "Orderings.ord_class.less" of
wneuper@59388
   378
  "le" => () | _ => error "Orderings.ord_class.less <-> le changed";
wneuper@59388
   379
(*--------------------------------------------------------------------vvvvvvvvvv*)
walther@59686
   380
val SOME (isa_str, eval_fn) = LibraryC.assoc (KEStore_Elems.get_calcs @{theory}, "le");
wneuper@59387
   381
wneuper@59388
   382
val SOME t = parseNEW @{context} "4 < 4";
wneuper@59388
   383
val SOME (str, thm) = adhoc_thm thy (isa_str, eval_fn) t;
walther@59876
   384
if str = "#less_4_4" andalso ThmC_Def.string_of_thm thm = "(4 < 4) = False"
wneuper@59388
   385
then () else error "adhoc_thm  4 < 4  changed";
wneuper@59387
   386
wneuper@59388
   387
val SOME t = parseNEW @{context} "a < 4";
wneuper@59388
   388
case adhoc_thm thy (isa_str, eval_fn) t of
wneuper@59388
   389
NONE => () | _ => error "adhoc_thm  a < 4  does NOT result in NONE";
wneuper@59387
   390
wneuper@59387
   391
wneuper@59388
   392
(*--------------------------------------------------------------------vvvvvvvvvv*)
walther@59686
   393
val SOME (isa_str, eval_fn) = LibraryC.assoc (KEStore_Elems.get_calcs @{theory}, "PLUS");
wneuper@59388
   394
val SOME t = parseNEW @{context} "1 + 2";
wneuper@59388
   395
val SOME (str, thm) = adhoc_thm thy (isa_str, eval_fn) t;
walther@59876
   396
if str = "#: 1 + 2 = 3" andalso ThmC_Def.string_of_thm thm = "1 + 2 = 3"
wneuper@59388
   397
then () else error "adhoc_thm  1 + 2  changed";
wneuper@59387
   398
wneuper@59388
   399
(*--------------------------------------------------------------------vvvvvvvvvv*)
walther@59686
   400
val SOME (isa_str, eval_fn) = LibraryC.assoc (KEStore_Elems.get_calcs @{theory}, "DIVIDE");
wneuper@59388
   401
val SOME t = parseNEW @{context} "6 / -8";
wneuper@59388
   402
val SOME (str, thm) = adhoc_thm thy (isa_str, eval_fn) t;
walther@59876
   403
if str = "#divide_e6_-8" andalso ThmC_Def.string_of_thm thm = "6 / -8 = -3 / 4"
wneuper@59388
   404
then () else error "adhoc_thm  1 + 2  changed";
wneuper@59387
   405
wneuper@59387
   406
walther@59603
   407
case assoc_calc thy "Prog_Expr.ident" of
walther@59603
   408
  "ident" => () | _ => error "Prog_Expr.ident <-> ident  changed";
wneuper@59388
   409
(*--------------------------------------------------------------------vvvvvvvvvv*)
walther@59686
   410
val SOME (isa_str, eval_fn) = LibraryC.assoc (KEStore_Elems.get_calcs @{theory}, "ident");
wneuper@59387
   411
wneuper@59388
   412
val SOME t = parseNEW @{context} "3 =!= 3";
wneuper@59388
   413
val SOME (str, thm) = adhoc_thm thy (isa_str, eval_fn) t;
walther@59876
   414
if str = "#ident_(3)_(3)" andalso ThmC_Def.string_of_thm thm = "(3 =!= 3) = True"
wneuper@59388
   415
then () else error "adhoc_thm  (3 =!= 3)  changed";
wneuper@59387
   416
wneuper@59388
   417
val SOME t = parseNEW @{context} "\<not> (4 + (4 * x + x ^ 2) =!= 0)";
wneuper@59388
   418
val SOME (str, thm) = adhoc_thm thy (isa_str, eval_fn) t;
walther@59876
   419
if str = "#ident_(4 + (4 * x + x ^ 2))_(0)" andalso ThmC_Def.string_of_thm thm = "(4 + (4 * x + x ^ 2) =!= 0) = False"
wneuper@59388
   420
then () else error "adhoc_thm  (\<not> (4 + (4 * x + x ^ 2) =!= 0))  changed";
wneuper@59403
   421
wneuper@59403
   422
"----------- fun power -------------------------------------------------------------------------";
wneuper@59403
   423
"----------- fun power -------------------------------------------------------------------------";
wneuper@59403
   424
"----------- fun power -------------------------------------------------------------------------";
wneuper@59403
   425
if power 2 3 = 8 then () else error "power 2 3 = 8";
wneuper@59403
   426
if power ~2 3 = ~8 then () else error "power ~2 3 = ~8";
wneuper@59403
   427
if power ~3 2 = 9 then () else error "power ~3 2 = 9";
wneuper@59403
   428
(power 3 ~2; error "power 3 ~2: should raise an exn") handle _ => 000;
wneuper@59403
   429
wneuper@59403
   430
"----------- fun divisors ----------------------------------------------------------------------";
wneuper@59403
   431
"----------- fun divisors ----------------------------------------------------------------------";
wneuper@59403
   432
"----------- fun divisors ----------------------------------------------------------------------";
wneuper@59403
   433
if divisors 30 = [5, 3, 2] then () else error "divisors 30 = [5, 3, 2]";
wneuper@59403
   434
if divisors 32 = [2, 2, 2, 2, 2] then () else error "divisors 32 = [2, 2, 2, 2, 2]";
wneuper@59403
   435
if divisors 60 = [5, 3, 2, 2] then () else error "divisors 60 = [5, 3, 2, 2]";
wneuper@59403
   436
if divisors 11 = [11] then () else error "divisors 11 = [11]";
wneuper@59403
   437
wneuper@59403
   438
"----------- fun doubles, fun squfact ----------------------------------------------------------";
wneuper@59403
   439
"----------- fun doubles, fun squfact ----------------------------------------------------------";
wneuper@59403
   440
"----------- fun doubles, fun squfact ----------------------------------------------------------";
wneuper@59403
   441
if doubles [2,3,4] = [] then () else error "doubles [2,3,4] changed";
wneuper@59403
   442
if doubles [2,3,3,5,5,7] = [5, 3] then () else error "doubles [2,3,3,5,5,7] changed";
wneuper@59403
   443
wneuper@59403
   444
if squfact 30 = 1 then () else error "squfact  30  changed";
wneuper@59403
   445
if squfact 32 = 4 then () else error "squfact  32  changed";
wneuper@59403
   446
if squfact 60 = 2 then () else error "squfact  60  changed";
wneuper@59403
   447
if squfact 11 = 1 then () else error "squfact  11  changed";