TFL/test1.sml
author paulson
Fri, 31 Jan 1997 17:13:19 +0100
changeset 2572 8a47f85e7a03
parent 2112 3902e9af752f
permissions -rw-r--r--
ex_impE was incorrectly listed as Safe
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2112
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
     1
(*---------------------------------------------------------------------------
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
     2
 * Pattern matching extensions.
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
     3
 *---------------------------------------------------------------------------*)
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
     4
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
     5
fun cread thy s = read_cterm (sign_of thy) (s, (TVar(("DUMMY",0),[])));
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
     6
fun read thy = term_of o cread thy;
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
     7
fun Term s = read WF1.thy s;
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
     8
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
     9
fun Rfunc thy R eqs =
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    10
   let val {induction,rules,theory,tcs} = 
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    11
              timeit(fn () => Tfl.Rfunction thy (read thy R) (read thy eqs))
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    12
   in {induction=induction, rules=rules, theory=theory, 
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    13
       tcs = map (cterm_of (sign_of theory)) tcs}
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    14
   end;
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    15
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    16
fun def tm = timeit (fn () => Tfl.function WF1.thy (Term tm));
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    17
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    18
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    19
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    20
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    21
(*---------------------------------------------------------------------------
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    22
 * Normal patterns
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    23
 *---------------------------------------------------------------------------*)
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    24
def "(f(x,y) = x+y)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    25
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    26
def "(f1 0 = 1) & (f1 (Suc n) = 2)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    27
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    28
(*---------------------------------------------------------------------------
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    29
 * Omitted patterns
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    30
 *---------------------------------------------------------------------------*)
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    31
def "(f2 0 = 1)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    32
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    33
def "(f3 (h#t) = h)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    34
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    35
def "(f4 [a,b] = a)  &  (f4 [b] = b)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    36
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    37
def "(f5 (0,0) = 0)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    38
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    39
def "(f6 (0,0) = 0) & (f6 (0,Suc x) = x) & (f6 (Suc x, y) = y+x)"; 
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    40
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    41
def "(f7 (Suc 0, h#t) = 1) & (f7 (Suc(Suc n),h1#h2#t) = h1)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    42
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    43
def "(f8 (Suc(Suc n),h1#h2#t) = h1)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    44
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    45
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    46
(*---------------------------------------------------------------------------
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    47
 * Overlapping patterns 
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    48
 *---------------------------------------------------------------------------*)
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    49
def "(f9 (h1#h2#t) = t) & (f9 x = x)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    50
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    51
def "(g (x,0) = 1) & (g (0,x) = 2)"; 
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    52
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    53
def "(g1 (0,x) = x) & (g1 (x,0) = x)"; 
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    54
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    55
def "(g2 ([], a#b#x) = 1) & (g2 (a#b#x, y) = 2) & (g2 (z, a#y) = a)";	
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    56
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    57
def "(g3 (x,y,0) = 1) & (g3 (x,0,y) = 2) & (g3 (0,x,y) = x)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    58
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    59
def "(g4 (0,y,z) = 1) & (g4 (x,0,z) = 2) & (g4 (x,y,0) = x)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    60
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    61
def "(g5(0,x,y,z) = 1) & (g5(w,0,y,z) = 2) & (g5(w,x,0,z) = z) & \
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    62
  \  (g5(w,x,y,0) = y)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    63
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    64
def "(g6 (0,w,x,y,z) = 1) & (g6 (v,0,x,y,z) = 2) & (g6 (v,w,0,y,z) = z) & \
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    65
  \  (g6 (v,w,x,0,z) = z) & (g6 (v,w,x,y,0) = 0)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    66
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    67
def "(g7 [x, 0] = x) & (g7 [Suc v] = 1) & (g7 z = 2)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    68
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    69
def "(g8 (h1#h2#h3#h4#h5#h6) = [h1,h2,h3,h4,h5]# g8 h6) & (g8 x = [x])";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    70
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    71
(* Normal *)
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    72
def "(g9 (Suc(Suc x)) = 1) & (g9 (Suc x) = 2) & (g9 0 = 0)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    73
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    74
(*---------------------------------------------------------------------------
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    75
 * Inaccessible patterns
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    76
 *---------------------------------------------------------------------------*)
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    77
def "(h x = 1) & (h x = 2)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    78
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    79
def "(h1 (x,0) = 1) & (h1 (x,Suc y) = 2) & \
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    80
  \  (h1 (x,y) = x) & (h1 (x,y) = y)";
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    81
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    82
def "(h2 (x,0) = 1) & (h2 (0,x) = 2) & \
3902e9af752f Konrad Slind's TFL
paulson
parents:
diff changeset
    83
  \  (h2 (0,0) = 0) & (h2 (x,y) = x)";