First exercises from The Little Schemer using Common Lisp

gistfile1.cl

(defun atom? (x)
  (not (listp x)))

(defun lat? (x)
  (cond
   ((null x) t)
   ((atom? (car x)) (lat? (cdr x)))
   (t nil)))

(defun member? (a lat)
  (cond
   ((null lat) nil)
   (t (or (eql (car lat) a)
        (member? a (cdr lat))))))

(defun rember (a lat)
  (cond
   ((null lat) '())
   (t (cond
       ((eql (car lat) a) (cdr lat))
       (t (cons (car lat) (rember a (cdr lat))))))))

(defun my-rember (a lat)
  (cond
   ((null lat) '())
   ((eql (car lat) a) (cdr lat))
   (t (cons (car lat) (my-rember a (cdr lat))))))

(defun firsts (l)
  (cond
   ((null l) '())
   (t (cons (car (car l))
            (firsts (cdr l))))))

(defun insertR (new old lat)
  (cond
   ((null lat) '())
   ((eql (car lat) old) (cons old
                              (cons new (cdr lat))))
   (t (cons (car lat)
            (insertR new old (cdr lat))))))

(defun insertL (new old lat)
  (cond
   ((null lat) '())
   ((eql (car lat) old) (cons new lat))
   (t (cons (car lat) (insertL new old (cdr lat))))))

(defun my-subst (new old lat)
  (cond
   ((null lat) '())
   ((eql (car lat) old) (cons new (cdr lat)))
   (t (cons (car lat) (my-subst new old (cdr lat))))))

(defun subst-2 (new o1 o2 lat)
  (cond
   ((null lat) '())
   ((eql (car lat) o1) (cons new (cdr lat)))
   ((eql (car lat) o2) (cons new (cdr lat)))
   (t (cons (car lat) (subst-2 new o1 o2 (cdr lat))))))

(defun multirember (a lat)
  (cond
   ((null lat) '())
   ((eql (car lat) a) (multirember a (cdr lat)))
   (t (cons (car lat) (multirember a (cdr lat))))))

(defun multiinsertR (new old lat)
  (cond
   ((null lat) '())
   ((eql (car lat) old) (cons old
                              (cons new (multiinsertR new old (cdr lat)))))
   (t (cons (car lat) (multiinsertR new old (cdr lat))))))

(defun multiinsertL (new old lat)
  (cond
   ((null lat) '())
   ((eql (car lat) old) (cons new
                              (cons old (multiinsertL new old (cdr lat)))))
   (t (cons (car lat) (multiinsertL new old (cdr lat))))))

(defun multisubst (new old lat)
  (cond
   ((null lat) '())
   ((eql (car lat) old) (cons new (multisubst new old (cdr lat))))
   (t (cons (car lat) (multisubst new old (cdr lat))))))

(defun o+ (m n)
  (cond
   ((zerop n) m)
   (t (1+ (o+ m (1- n))))))

(defun o- (m n)
  (cond
    ((zerop n) m)
    (t (1- (o- m (1- n))))))

;; 5 x 4 is equal to 5 + (5 x 3)
;; 5 x 3 is equal to 5 + (5 x 2)
;; 5 x 2 is equal to 5 + (5 x 1)
;; 5 x 1 is equal to 5 + (5 x 0)
;; 5 x 0 is equal to 0
;; therefore 5 x 4 = 5 + 5 + 5 + 5 + 0

(defun my-mult (m n)
  (cond
    ((zerop n) 0)
    (t (o+ m (my-mult m (1- n))))))

(defun addtup (tup)
  (cond
    ((null tup) 0)
    (t (o+ (car tup) (addtup (cdr tup))))))

(defun tup+ (tup1 tup2)
  (cond
    ((null tup1) tup2)
    ((null tup2) tup1)
    (t (cons (o+ (car tup1) (car tup2))
	     (tup+ (cdr tup1) (cdr tup2))))))

(defun my-gt (m n)
  (cond
    ((zerop m) nil)
    ((zerop n) t)
    (t (my-gt (1- m) (1- n)))))

(defun my-lt (m n)
  (cond
    ((zerop n) nil)
    ((zerop m) t)
    (t (my-lt (1- m) (1- n)))))

(defun my-equals (m n)
  (cond
    ((my-gt m n) nil)
    ((my-lt m n) nil)
    (t t)))

(defun my-exponent (m n)
  (cond
    ((zerop n) 1)
    (t (my-mult m (my-exponent m (1- n))))))

(defun my-division (m n)
  (cond
    ((my-lt m n) 0)
    (t (1+ (my-division (o- m n) n)))))