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