1;;sample code for type inference
2;;benchmark test
3
4(defun tarai (x y z)
5    (the <fixnum> x)(the <fixnum> y)(the <fixnum> z)
6    (if (<= x y)
7        y
8        (tarai (tarai (- x 1) y z) (tarai (- y 1) z x) (tarai (- z 1) x y)) ))
9
10(defun tarai* (x y z)
11    (if (<= x y)
12        y
13        (tarai* (tarai* (- x 1.0) y z) (tarai* (- y 1.0) z x) (tarai* (- z 1.0) x y)) ))
14
15(defun fib (n)
16    (the <fixnum> n)
17    (cond ((= n 1) 1)
18          ((= n 2) 1)
19          (t (+ (fib (- n 1)) (fib (- n 2)))) ))
20
21(defun fib* (n)
22    (cond ((= n 1.0) 1.0)
23          ((= n 2.0) 1.0)
24          (t (+ (fib* (- n 1.0))
25                (fib* (- n 2.0))))))
26
27(defun ack (m n)
28    (the <fixnum> m)(the <fixnum> n)
29    (cond ((= m 0) (+ n 1))
30          ((= n 0) (ack (- m 1) 1))
31          (t (ack (- m 1) (ack m (- n 1)))) ))
32
33
34(defgeneric gfib (n)
35    (:method ((n <integer>)) (cond ((= n 1) 1)
36                                   ((= n 2) 1)
37                                   (t (+ (gfib (- n 1)) (gfib (- n 2)))) )))
38
39(defun tak (x y z)
40    (the <fixnum> x)(the <fixnum> y)(the <fixnum> z)
41    (if (>= y x)
42        z
43        (tak (tak (- x 1) y z) (tak (- y 1) z x) (tak (- z 1) x y)) ))
44
45(defun listn (n)
46    (if (not (= 0 n))
47        (cons n (listn (- n 1))) ))
48
49(defconstant ll-18 (listn 18))
50(defconstant ll-12 (listn 12))
51(defconstant ll-6 (listn 6))
52(defconstant ll-32 (listn 32))
53(defconstant ll-16 (listn 16))
54(defconstant ll-8 (listn 8))
55
56(defmacro shorterp (x y)
57    `(< (length ,x) (length ,y)) )
58
59(defun takl (x y z)
60    (if (not (shorterp y x))
61        z
62        (takl (takl (cdr x) y z) (takl (cdr y) z x) (takl (cdr z) x y)) ))
63
64;;call: (takl ll-32 ll-16 ll-8)
65
66(defun ctak (x y z)
67    (catch 'ctak-aux (ctak-aux x y z)) )
68
69(defun ctak-aux (x y z)
70    (if (>= y x)
71        (throw 'ctak-aux z)
72        (ctak-aux
73           (catch 'ctak-aux (ctak-aux (- x 1) y z))
74           (catch 'ctak-aux (ctak-aux (- y 1) z x))
75           (catch 'ctak-aux (ctak-aux (- z 1) x y)))))
76
77
78
79