Skip to content

Instantly share code, notes, and snippets.

@Jeanhwea

Jeanhwea/theRootOfLisp.el

Created August 3, 2017 16:54
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save Jeanhwea/f2a748c0e60c43d61b80ff7ed46577e1 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save Jeanhwea/f2a748c0e60c43d61b80ff7ed46577e1 to your computer and use it in GitHub Desktop.
Download ZIP
The Root of Lisp
Raw
theRootOfLisp.el
;; http://www.paulgraham.com/rootsoflisp.html
;; ========================================
;; ATOM := [a-zA-Z]*
;; LIST := (EXPR1 EXPR2 ...)
;; EXPR := ATOM | LIST
;; EXPR
foo
()
(foo)
(foo bar)
(a b (c) d)
;; ========================================
;; quote, atom, eq, car, cdr, cons, cond
;; quote.
(quote a) ;=> a
'a ;=> a
(quote (a b c)) ;=> (a b c)
;; atomr. (t means true, nil means false)
(atom 'a) ;=> t
(atom '(a b c)) ;=> nil
(atom '()) ;=> t
;; --------------------
(atom (atom 'a)) ;=> t
(atom '(atom 'a)) ;=> nil, quote avoids to eval an EXPR
;; eq.
(eq 'a 'a) ;=> t
(eq 'a 'b) ;=> nil
(eq '() '()) ;=> t
;; car.
(car '(a b c)) ;=> a
;; cdr.
(cdr '(a b c)) ;=> (b c)
;; cons.
(cons 'a '(b c)) ;=> (a b c)
(cons 'a (cons 'b (cons 'c '()))) ;=> (a b c)
;; --------------------
(car (cons 'a '(b c))) ;=> a
(cdr (cons 'a '(b c))) ;=> (b c)
;; cond
(cond ((eq 'a 'b) 'first)
((atom 'a) 'second)) ;=> second
;; ========================================
;; lambda
((lambda (x) (cons x '(b))) 'a) ;=> (a b)
((lambda (x y) (cons x (cdr y)))
'z
'(a b c)) ;=> (z b c)
(subst 'm 'b '(a b (a b c) d)) ;=> (a m (a m c) d)
;; recursive
(defun hyq-subst (x y z)
(cond ((atom z)
(cond ((eq z y) x)
('t z)))
('t (cons (hyq-subst x y (car z))
(hyq-subst x y (cdr z))))))
(hyq-subst 'm 'b '(a b (a b c) d)) ;=> (a m (a m c) d)
;; cadr
(cadr '((a b) (c d) e)) ;=> (c d)
(caddr '((a b) (c d) e)) ;=> e
(cdar '((a b) (c d) e)) ;=> (b)
;; list
(cons 'a (cons 'b (cons 'c '()))) ;=> (a b c)
(list 'a 'b 'c) ;=> (a b c)
; The Lisp defined in McCarthy's 1960 paper, translated into CL.
; Assumes only quote, atom, eq, cons, car, cdr, cond.
; Bug reports to lispcode@paulgraham.com.
(defun null. (x)
(eq x '()))
(defun and. (x y)
(cond (x (cond (y 't) ('t '())))
('t '())))
(defun not. (x)
(cond (x '())
('t 't)))
(defun append. (x y)
(cond ((null. x) y)
('t (cons (car x) (append. (cdr x) y)))))
(defun list. (x y)
(cons x (cons y '())))
(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))))))
(defun assoc. (x y)
(cond ((eq (caar y) x) (cadar y))
('t (assoc. x (cdr y)))))
(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)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment