language: Common Lisp (clisp) (clisp 2.47)
date: 977 days 22 hours ago
link:
visibility: public 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

(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 ((null. y) '())
        ((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)))
    ((eq (caar e) 'macro)
     (cond
      ((eq (cadar e) 'lambda)
       (eval. (eval. (car (cdddar e))
                     (cons (list. (car (caddar e)) (cadr 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)))))
                  
(print                   
(let ((e '((macro lambda (x) (list. (quote car) (list. (quote cdr) x)))
           (cons (quote x) (cons (quote y) nil))))
      (bindings
       ;; Emacs 22 (but `symbol-function' is not portable):
       ; `((list. ,(symbol-function 'list.)))))
       ;; Expanded version of same:
       '((list. (lambda (x y) (cons x (cons y (quote nil))))))))
  (eval. e bindings)))