test/Tools/isac/Knowledge/inssort.sml
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 28 Sep 2010 09:06:56 +0200
branchisac-update-Isa09-2
changeset 38031 460c24a6a6ba
parent 37991 028442673981
child 38063 d2bdc4095e73
permissions -rw-r--r--
tuned error and writeln

# raise error --> error
# writeln in atomtyp, atomty, atomt and xmlsrc
neuper@37906
     1
(* use"test-inssort.sml";
neuper@37906
     2
   W.N.17.6.00
neuper@37906
     3
*)
neuper@37906
     4
neuper@37906
     5
(* insertion sort, would need lists different from script-lists WN.11.00
neuper@37906
     6
WN.7.6.03: -"- started with someList :: 'a list => unl, fun dest_list *)
neuper@37906
     7
neuper@37906
     8
"--------------- sort [1,4,3,2] by rewrite_set ----------------";
neuper@37991
     9
val thy' = "InsSort";
neuper@37906
    10
val ct = "sort [1,4,3,2]";
neuper@37906
    11
"--- 1 ---";
neuper@37906
    12
val rls = "ins_sort";
neuper@37906
    13
val (ct,_) = the (rewrite_set thy' "eval_rls" false rls ct);
neuper@37906
    14
if ct="[1, 2, 3, 4]" then "sort [1,4,3,2] OK"
neuper@38031
    15
else error "sort [1,4,3,2] didn't work";
neuper@37906
    16
neuper@37906
    17
neuper@37906
    18
"---------------- sort [1,3,2] by rewrite stepwise ----------------";
neuper@37991
    19
val thy' = "InsSort";
neuper@37906
    20
val ct = "sort [1,3,2]";
neuper@37906
    21
"--- 1 ---";
neuper@37906
    22
val thm = ("sort_def","");
neuper@37906
    23
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    24
(*val ct = "foldr ins [#1::real, #3::real, #2::real] []"*)
neuper@37906
    25
"--- 2 ---";
neuper@37906
    26
val thm = ("foldr_rec","");
neuper@37906
    27
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    28
(*val ct = "foldr ins [#3, #2] (ins [] #1)"*)
neuper@37906
    29
"--- 3 ---";
neuper@37906
    30
val thm = ("ins_base","");
neuper@37906
    31
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    32
(*val ct = "foldr ins [#3, #2] [#1]"*)
neuper@37906
    33
"--- 4 ---";
neuper@37906
    34
val thm = ("foldr_rec","");
neuper@37906
    35
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    36
(*val ct = "foldr ins [#2] (ins [#1] #3)"*)
neuper@37906
    37
"--- 5 ---";
neuper@37906
    38
val thm = ("ins_rec","");
neuper@37906
    39
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    40
(*val ct = "foldr ins [#2] (if #1 < #3 then #1 # ins [] #3 else [#3, #1])"*)
neuper@37906
    41
"--- 6 ---";
neuper@37906
    42
val op_ = "le";
neuper@37906
    43
val (ct,_) = the (calculate thy' op_ ct);
neuper@37906
    44
(*val ct = "foldr ins [#2] (if True then #1 # ins [] #3 else [#3, #1])"*)
neuper@37906
    45
"--- 7 ---";
neuper@37906
    46
val thm = ("if_True","");
neuper@37906
    47
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    48
(*val ct = "foldr ins [#2] (#1 # ins [] #3)"*)
neuper@37906
    49
"--- 8 ---";
neuper@37906
    50
val thm = ("ins_base","");
neuper@37906
    51
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    52
(*val ct = "foldr ins [#2] [#1, #3]"*)
neuper@37906
    53
"--- 9 ---";
neuper@37906
    54
val thm = ("foldr_rec","");
neuper@37906
    55
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    56
(*val ct = "foldr ins [] (ins [#1, #3] #2)"*)
neuper@37906
    57
"--- 10 ---";
neuper@37906
    58
val thm = ("ins_rec","");
neuper@37906
    59
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    60
(*val ct = "foldr ins [] (if #1 < #2 then #1 # ins [#3] #2 else [#2, #1, #3])"*)
neuper@37906
    61
"--- 11 ---";
neuper@37906
    62
val op_ = "le";
neuper@37906
    63
val (ct,_) = the (calculate thy' op_ ct);
neuper@37906
    64
(*val ct = "foldr ins [] (if True then #1 # ins [#3] #2 else [#2, #1, #3])"*)
neuper@37906
    65
"--- 12 ---";
neuper@37906
    66
val thm = ("if_True","");
neuper@37906
    67
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    68
(*"foldr ins [] (#1 # ins [#3] #2)"*)
neuper@37906
    69
"--- 13 ---";
neuper@37906
    70
val thm = ("ins_rec","");
neuper@37906
    71
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    72
(*"foldr ins [] (#1 # (if #3 < #2 then #3 # ins [] #2 else [#2, #3]))"*)
neuper@37906
    73
"--- 14 ---";
neuper@37906
    74
val op_ = "le";
neuper@37906
    75
val (ct,_) = the (calculate thy' op_ ct);
neuper@37906
    76
(*val ct = "foldr ins [] (#1 # (if False then #3 # ins [] #2 else [#2, #3]))"*)
neuper@37906
    77
"--- 15 ---";
neuper@37906
    78
val thm = ("if_False","");
neuper@37906
    79
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    80
(*val ct = "foldr ins [] [#1, #2, #3]"*)
neuper@37906
    81
"--- 16 ---";
neuper@37906
    82
val thm = ("foldr_base","");
neuper@37906
    83
val (ct,_) = the (rewrite thy' "tless_true" "eval_rls" false thm ct);
neuper@37906
    84
(*val ct = "[#1, #2, #3]"*)
neuper@37906
    85
if ct="[1, 2, 3]" then "sort [1,3,2] OK"
neuper@38031
    86
else error "sort [1,3,2] didn't work";
neuper@37906
    87
neuper@37906
    88
neuper@37906
    89
"---------------- sort [1,3,2] from script ----------------";
neuper@37906
    90
val fmz = ["unsorted [1,3,2]", "sorted S"];
neuper@37906
    91
val (dI',pI',mI') = 
neuper@37991
    92
  ("InsSort", ["inssort","functional"], ("InsSort","inssort"));
neuper@37906
    93
val p = e_pos'; val c = []; 
neuper@37906
    94
neuper@37906
    95
neuper@37906
    96
neuper@37906
    97
(* ------- 17.6.00: mit kleinen problemen aufgegeben
neuper@37906
    98
val scr=Script ((term_of o the o (parse thy))
neuper@37906
    99
	       "Script Sort (u_::'a list) =   \
neuper@37906
   100
		\ Rewrite_Set ins_sort False u_");
neuper@37906
   101
neuper@37906
   102
val scr=Script ((term_of o the o (parse thy))
neuper@37906
   103
      "Script Ins_sort (u_::real list) =          \
neuper@37906
   104
       \ (let u_ = Rewrite sort_def   False u_; \
neuper@37906
   105
       \      u_ = Rewrite foldr_rec  False u_; \
neuper@37906
   106
       \      u_ = Rewrite ins_base   False u_; \
neuper@37906
   107
       \      u_ = Rewrite foldr_rec  False u_; \
neuper@37906
   108
       \      u_ = Rewrite ins_rec    False u_; \
neuper@37906
   109
       \      u_ = Calculate le u_;             \
neuper@37906
   110
       \      u_ = Rewrite if_True    False u_; \
neuper@37906
   111
       \      u_ = Rewrite ins_base   False u_; \
neuper@37906
   112
       \      u_ = Rewrite foldr_rec  False u_; \
neuper@37906
   113
       \      u_ = Rewrite ins_rec    False u_; \
neuper@37906
   114
       \      u_ = Calculate le u_;             \
neuper@37906
   115
       \      u_ = Rewrite if_True    False u_; \
neuper@37906
   116
       \      u_ = Rewrite ins_rec    False u_; \
neuper@37906
   117
       \      u_ = Calculate le u_;             \
neuper@37906
   118
       \      u_ = Rewrite if_False   False u_; \
neuper@37906
   119
       \      u_ = Rewrite foldr_base False u_  \
neuper@37906
   120
       \  in u_)");
neuper@37906
   121
val scr=parse thy
neuper@37906
   122
      "Script Ins_sort (u_::real list) =          \
neuper@37906
   123
       \ (let u_ = Rewrite sort_def   False u_; \
neuper@37906
   124
       \      u_ = Rewrite foldr_rec  False u_; \
neuper@37906
   125
       \      u_ = Rewrite ins_base   False u_; \
neuper@37906
   126
       \      u_ = Rewrite foldr_rec  False u_; \
neuper@37906
   127
       \      u_ = Rewrite ins_rec    False u_; \
neuper@37906
   128
       \      u_ = Calculate le u_;             \
neuper@37906
   129
       \      u_ = Rewrite if_True    False u_; \
neuper@37906
   130
       \      u_ = Rewrite ins_base   False u_; \
neuper@37906
   131
       \      u_ = Rewrite foldr_rec  False u_; \
neuper@37906
   132
       \      u_ = Rewrite ins_rec    False u_; \
neuper@37906
   133
       \      u_ = u_   \
neuper@37906
   134
       \  in u_)";
neuper@37906
   135
neuper@37906
   136
atomty (term_of (the scr));
neuper@37906
   137
neuper@37906
   138
------- *)