Exercise 2.5 from SICP, in Common Lisp

sicp-2.5.lisp

;; Exercise 2.5 from SICP, in Common Lisp

(defun x-cons (a b)
  (labels ((x-power (x n &optional acc)
             (let ((acc (or acc x)))
               (if (= n 1)
                   acc
                   (x-power x (- n 1) (* acc x))))))
    (* (x-power 2 a) (x-power 3 b))))

(defun x-find-exp (pair base)
  "returns exponent for given base (either 2 or 3) part in pair"
  (let ((other-base (if (= base 2) 3 2)))
    (labels ((x-log (n base &optional guess)
               (let ((guess (or guess 1)))
                 (if (= n base)
                     guess
                     (x-log (/ n base) base (+ 1 guess)))))
             (divide-by-other-base (pair)
               (let ((elim (/ pair other-base)))
                 (if (not (= (rem elim other-base) 0))
                     elim
                     (divide-by-other-base elim)))))
      (x-log (divide-by-other-base pair) base))))

(defun x-car (pair)
  (x-find-exp pair 2))

(defun x-cdr (pair)
  (x-find-exp pair 3))

(defun test-x-cons ()
  (let ((d (x-cons 1 1)))
    (assert (= (x-car d) 1))
    (assert (= (x-cdr d) 1)))
  (let ((d (x-cons 1 8298)))
    (assert (= (x-car d) 1))
    (assert (= (x-cdr d) 8298)))
  (let ((d (x-cons 8298 1)))
    (assert (= (x-car d) 8298))
    (assert (= (x-cdr d) 1)))
  (let ((d (x-cons 472 1353)))
    (assert (= (x-car d) 472))
    (assert (= (x-cdr d) 1353))))