jlisp/test at master · jwthomp/jlisp · GitHub

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
81
82
(print "TEST ONE")

(defun caar (a) (car (car a)))
(defun caddr (a) (car (cdr (cdr a))))
(defun cadr (a) (car (cdr a)))
(defun cadar (a) (car (cdr (car a))))

(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)
	(cond
		((eq y 'nil) (cons x y))
		('t (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)))))

"Writing eval.."
"First just eval something basic"

(defun eval2 (e)
	(cond
		((atom e) e)
	))

(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)))))