A lisp interpreter

The article " The roots of lisp", written by Paul Graham was a major motivation for me to learn lisp. In that article, he actually converts the original paper by John McCarthy(inventor of lisp) into running code in common lisp. I have not (yet) read the original (completely) but I found the commentary by Paul Graham to be relatively simple, but highly effective.

In this post, all I want to do is illustrate all the code found in the article "The roots of lisp" without any explanations whatsoever. I will post in more detail about the various functions later, but for now, please refer to the complete article for any explanations. The code was originally written for commonlisp but it works in emacs lisp too since the seven primitive operators are a part of emacs lisp.

I faced a few minor glitches while executing the code, and thanks to the people at comp.lang.lisp for clearing them. The glitches were due to the fact that the lambda form and the label notation are a bit modified in the more recent versions of common lisp.

The Seven Primitive Operators

;From Paul Graham's site
    ;see http://www.paulgraham.com/rootsoflisp.html

;P.S:- Any line beginning with a ';' is a comment and not to be executed
      ;Like this line for instance. Do not evaluate such lines.


;1)The Seven primitive operators

    ;a)quote

        (quote a)

        'a

        (quote (a b c))


   ;b)atom

        (atom 'a)

        (atom '(a b c))

        (atom '())

        (atom '(atom 'a))


   ;c)eq

        (eq 'a 'a)

        (eq 'a 'b)

        (eq '() '())


   ;d)car

       (car '(a b c))


   ;e)cdr

        (cdr '(a b c))


   ;f)cons

        (cons 'a (cons 'b (cons 'c '())))

        (car (cons 'a '(b c)))

        (cdr (cons 'a '(b c)))


   ;g)(cond (p1 e1) (p2 e2)  ... (pn en))

        (cond ((eq 'a 'b) 'first)
              ((atom 'a) 'second))

Denoting functions

;2) lambda -- ((lambda (p1 p2 ... pn) e) a1 ... an)

    ((lambda (x) (cons x '(b))) 'a)

    ((lambda (x y) (cons x (cdr y)))
      'z
      '(a b c))


    ;((lambda (f) (f '(b c)))
      ;(lambda (x) (cons 'a x)))

   ;Though the above function is theoretically correct,
    ;it is not working in any of the more recent versions of the lisp dialects

   ;The right way to do it in the more recent versions of lisp is as given below
      ;It works in clisp as well as emacslisp
    ((lambda (f) (funcall f '(b c)))
        (lambda (x) (cons 'a x)))
   
;The label function is obsolete

;(label subst1 (lambda (x y z)
           ;(cond ((atom z)(cond ((eq z y) x)
                                ;('t z)))
                 ;('t (cons (subst1 x y (car z))
                           ;(subst1 x y (cdr z)))))))

   ;The reason for using subst1 (instead of subst) is 
        ;because there is an in-built function
        ;(in common lisp as well as emacslisp) called subst with the same functionality

   ;(defun f (p1 ... pn) e) is equivalent to f=(label f (lambda (p1 ... pn) e))
    (defun subst1 (x y z)
     (cond ((atom z)
            (cond ((eq z y) x)
                  ('t z)))
            ('t (cons (subst1 x y (car z))
                      (subst1 x y (cdr z))))))

    (subst1 'm 'b '(a b (a b c) d))

    ;(cond (x y) ('t z)) is equivalent to
           ;if (x) then y else z (in languages like C, python, java ...)
    (cond (nil  0)
          ('t   1))

A few functions

;3) Some Functions

    ;Abbreviations

        (cadr '((a b) (c d) e))

        (caddr '((a b) (c d) e))

        (cdar  '((a b) (c d) e))

        (cons 'a (cons 'b (cons 'c '())))

        (list 'a 'b 'c)

    ;The periods after each of the functions is
       ;a)to  *distinguish* them from the primitive operators,
       ;b)to identify them as being built using the primitive functions
       ;c)to avoid clashes with existing functions

    ;a) (null. 'a) -- tests whether its argument is the empty list

        (defun null. (x)
            (eq x '()))

        (null. 'a)

        (null. '())

    ;b) (and. x y) -- return t if both its arguments do and returns () otherwise

        (defun and. (x y)
          (cond (x (cond (y 't) ('t '())))
                ('t '())))

        (and. (atom 'a) (eq 'a 'a))

        (and. (atom 'a) (eq 'a 'b))

    ;c) (not. x) return t if its argument returns (), and () if its arg returns t

        (defun not. (x)
          (cond (x '())
                ('t 't)))

        (not. (eq 'a 'a))

        (not. (eq 'a 'b))

    ;d) (append. x y) takes two lists and returns their concatenation

        (defun append. (x y)
          (cond ((null. x) y)
                ('t (cons (car x) (append. (cdr x) y)))))

        (append. '(a b) '(c d))

        (append. '()    '(c d))

    ;e) (pair. x y) takes two lists of the same length and return a list of
      ;two-element lists containing successive pairs of an element from each.

        (defun pair. (x y)
          (cond ((and. (null. x) (null. y)) '())
                ((and. (not. (atom x)) (not. (atom y)))
                       (cons (list (car x) (car y))
                             (pair. (cdr x) (cdr y))))))

         (pair. '(x y z) '(a b c))


    ;f) (assoc. x y) takes an atom x and a list y of the form created by pair. , 
;and returns the second element of the first list in y whose first element is x

        (defun assoc. (x y)
          (cond ((eq (caar y) x) (cadar y))
                ('t  (assoc. x (cdr y)))))

        (assoc. 'x '((x a) (y b)))

        (assoc. 'x '((x new) (x a) (y b)))

Finally, the interpreter

;4) The interpreter for our lisp

        (defun eval. (e a)
          (cond
            ((atom e) (assoc. e a))
            ((atom (car e))
             (cond
               ((eq (car e) 'quote) (cadr e))
               ((eq (car e) 'atom)  (atom (eval. (cadr e) a)))
               ((eq (car e) 'eq)    (eq   (eval. (cadr e) a)
                                          (eval. (caddr e) a)))
               ((eq (car e) 'car)   (car  (eval. (cadr e) a)))
               ((eq (car e) 'cdr)   (cdr  (eval. (cadr e) a)))
               ((eq (car e) 'cons)  (cons (eval. (cadr e) a)
                                          (eval. (caddr e) a)))
               ((eq (car e) 'cond)  (evcon. (cdr e) a))
               ('t (eval. (cons (assoc. (car e) a)
                                (cdr e))
                           a))))
            ((eq (caar e) 'label)
             (eval. (cons (caddar e) (cdr e))
                    (cons (list (cadar e) (car e)) a)))
            ((eq (caar e) 'lambda)
             (eval. (caddar e)
                    (append. (pair. (cadar e) (evlis. (cdr e) a))
                              a)))))

        (defun evcon. (c a)
          (cond ((eval. (caar c)  a)
                 (eval. (cadar c) a))
                ('t (evcon. (cdr c) a))))

        (defun evlis. (m a)
          (cond ((null. m) '())
                ('t (cons (eval.  (car m) a)
                          (evlis. (cdr m) a)))))

;Examples of our eval. function in action

        (eval. 'x '((x a) (y b)))

        (eval. '(eq 'a 'a) '())

        (eval. '(cons x '(b c))
               '((x a) (y b)))

        (eval. '(cond ((atom x) 'atom)
                      ('t 'list))
               '((x '(a b))))

        (eval. '(f '(b c))
               '((f (lambda (x) (cons 'a x)))))


        (eval. '((label firstatom (lambda (x)
                                    (cond ((atom x) x)
                                          ('t (firstatom (car x))))))
                  y)
                '((y ((a b) (c d)))))


        (eval. '((lambda (x y) (cons x (cdr y)))
                  'a
                  '(b c d))
               '())

        (eval. '(quote a) '())