-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy patheval.lisp
77 lines (76 loc) · 2.73 KB
/
eval.lisp
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
(label eval
(lambda (e a)
(cond ((atom e)
(cond ((eq e nil) nil)
((eq e t) t)
(t (cdr ((label assoc
(lambda (e a)
(cond ((null a) nil)
((eq e (caar a)) (car a))
(t (assoc e (cdr a))))))
e
a)))))
((atom (car e))
(cond ((eq (car e) (quote quote)) (cadr e))
((eq (car e) (quote car))
(car (eval (cadr e) a)))
((eq (car e) (quote cdr))
(cdr (eval (cadr e) a)))
((eq (car e) (quote cadr))
(cadr (eval (cadr e) a)))
((eq (car e) (quote caddr))
(caddr (eval (cadr e) a)))
((eq (car e) (quote caar))
(caar (eval (cadr e) a)))
((eq (car e) (quote cadar))
(cadar (eval (cadr e) a)))
((eq (car e) (quote caddar))
(caddar (eval (cadr e) a)))
((eq (car e) (quote atom))
(atom (eval (cadr e) a)))
((eq (car e) (quote null))
(null (eval (cadr e) a)))
((eq (car e) (quote cons))
(cons (eval (cadr e) a) (eval (caddr e) a)))
((eq (car e) (quote eq))
(eq (eval (cadr e) a) (eval (caddr e) a)))
((eq (car e) (quote cond))
((label evcond
(lambda (u a)
(cond ((eval (caar u) a)
(eval (cadar u) a))
(t (evcond (cdr u) a)))))
(cdr e) a))
(t (eval (cons (cdr ((label assoc
(lambda (e a)
(cond
((null a) nil)
((eq e (caar a)) (car a))
(t (assoc e (cdr a))))))
(car e) a))
(cdr e))
a))))
((eq (caar e) (quote lambda))
(eval (caddar e)
((label ffappend
(lambda (u v)
(cond ((null u) v)
(t (cons (car u)
(ffappend (cdr u) v))))))
((label pairup
(lambda (u v)
(cond ((null u) nil)
(t (cons (cons (car u) (car v))
(pairup (cdr u) (cdr v)))))))
(cadar e)
((label evlis
(lambda (u a)
(cond ((null u) nil)
(t (cons (eval (car u) a)
(evlis (cdr u) a))))))
(cdr e)
a))
a)))
((eq (caar e) (quote label))
(eval (cons (caddar e) (cdr e))
(cons (cons (cadar e) (car e)) a))))))