-
Notifications
You must be signed in to change notification settings - Fork 0
/
4_33.scm
49 lines (45 loc) · 1.54 KB
/
4_33.scm
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
(load "ch4-leval.scm")
(define (transform-quotation exp env)
(let ((content (cadr exp)))
(define (make-quoted-list input)
(if (null? input)
''()
(list 'cons (list 'quote (car input)) (make-quoted-list (cdr input)))))
(if (pair? content)
(eval (make-quoted-list content) env)
content)))
(define (text-of-quotation exp) (cadr exp))
(define (eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((quoted? exp) (transform-quotation exp env))
((assignment? exp) (eval-assignment exp env))
((definition? exp) (eval-definition exp env))
((if? exp) (eval-if exp env))
((lambda? exp)
(make-procedure (lambda-parameters exp)
(lambda-body exp)
env))
((begin? exp)
(eval-sequence (begin-actions exp) env))
((cond? exp) (eval (cond->if exp) env))
((application? exp) ; clause from book
(apply (actual-value (operator exp) env)
(operands exp)
env))
(else
(error "Unknown expression type -- EVAL" exp))))
; test
(define the-global-environment (setup-environment))
(define (run input)
(let ((output
(actual-value input the-global-environment)))
(announce-output output-prompt)
(user-print output)))
(run '(define (cons x y)
(lambda (m) (m x y))))
(run '(define (car z)
(z (lambda (p q) p))))
(run '(define (cdr z)
(z (lambda (p q) q))))
(run '(car (cdr '(a b))))