More Examples

1. Tower of Hanoi

C-version:
#include <iostream.h>
void move (int, char, char, char);
main()
{
move(3,'A','C','B');
}
void move (int ndiscs, char fromstick,
char tostick, char otherstick)
{
if (ndiscs==1)
cout<<"Move disc from "<<fromstick
<<" to "<<tostick<<endl;
else {
move(ndiscs-1,fromstick, otherstick, tostick);
move(1,fromstick, tostick, otherstick);
move(ndiscs-1,otherstick, tostick, fromstick);
}
}

Lisp-version
(defun move_disk (ndisc fromstick tostick otherstick)
(cond ((= ndisc 1)
(princ '|move disk from |)
(princ fromstick) princ '| to |)
(princ tostick) (terpri))
(t (move_disk (1- ndisc) fromstick
otherstick tostick)
(move_disk 1 fromstick tostick
otherstick)
(move_disk (1- ndisc) otherstick
tostick fromstick))))
(move_disk 'a 'b 'c)
move disk from A to C
move disk from A to B
move disk from C to B
move disk from A to C
move disk from B to A
move disk from B to C
move disk from A to C

2. Inheritance

Database:

(setf (get 'kitty 'is-a) 'cat)
(setf (get 'kitty 'name) 'kitty)
(setf (get 'kitty 'color) 'orange)
(setf (get 'kitty 'sex) 'M)
(setf (get 'cat 'is-a) 'mammal)
(setf (get 'mammal 'is-a) 'animal)
(setf (get 'mammal 'has-leg) 4)

(setf (get 'mary 'is-a) 'human)
(setf (get 'human 'has-leg) 2)
(setf (get 'human 'is-a) 'mammal)

(setf (get 'alan 'is-a) 'whale)
(setf (get 'whale 'has-leg) 0)
(setf (get 'whale 'is-a) 'mammal)

(defun legs (obj)

(cond ((null obj) nil)

((get obj 'has-leg))

(t (legs (get obj 'is-a)))))

(legs 'kitty)

4

(legs 'alan)

0

(legs 'mary)

2

3. Read-file and eval

(defun read_prop (filename)
(with-open-file (filep "person.dat")
(setq person (read filep))
(setq nfield (read filep))
(do ((nf nfield (1- nf)))
((zerop nf))
(setq field (read filep))
(remprop person field)
(setq nvalue (read filep))
(cond ((= nvalue 1)
(setf (get person field) (read filep)))
(t (do ((nv nvalue (1- nv)))
((zerop nv))
(setq value (read filep))
(setf (get person field)
(append (get person field)
(list value))))))))

(setf (get person 'bmi)
`(/ (/ (get ',person 'weight)
(get ',person 'height))
(get ',person 'height)))

(setf (get person 'is-fat)
`(cond ((< (get ',person 'age) 40)
(cond ((< (eval (get ',person 'bmi)) 25)
'fit)

(t 'fat)))

(t (cond ((< (eval (get ',person 'bmi)) 27)
'fit))
(t 'fat)))))