Implement till 4.15
parent
0042f1773f
commit
32b43220bf
|
@ -166,6 +166,55 @@
|
|||
(assert (make-unbound! 'b env-3) #t)
|
||||
(assert (make-unbound! 'b env-3) #f)
|
||||
|
||||
(display "\nex-4.14\n")
|
||||
(display "\nex-4.14 - map\n")
|
||||
|
||||
; Louis's implementation of map will not work because the evaluator will
|
||||
; evaluate the lambda expression into a procedure list. The Scheme interpreter
|
||||
; does not know how to evaluate that list. Hence, the operation fails.
|
||||
|
||||
(display "[answered]\n")
|
||||
|
||||
(display "\nex-4.15 - halts?\n")
|
||||
|
||||
(define (run-forever) (run-forever))
|
||||
|
||||
(define (try p)
|
||||
(if (halts? p p)
|
||||
(run-forever)
|
||||
'halted))
|
||||
|
||||
; Suppose (try try) runs forever then halts? evaluates to wrong and try returns
|
||||
; halt. That is a contradiction. Suppose (try try) halts. Then halts? evaluates
|
||||
; to true and try runs forever; again a contradiction. Therefore, a general
|
||||
; procedure halts? cannot exist.
|
||||
|
||||
(display "[answered]\n")
|
||||
|
||||
(display "\nex-4.16\n")
|
||||
|
||||
(define (lookup-variable-value var env)
|
||||
(let ((pair (find-pair-env var env)))
|
||||
(if (eq? pair #f)
|
||||
(error "Unbound variable" var)
|
||||
(let ((value (frame-val pair)))
|
||||
(if (eq? value '*unassigned*)
|
||||
(error "Unassigned variable" var)
|
||||
value)))))
|
||||
|
||||
(define env-0 the-empty-environment)
|
||||
(define env-1 (extend-environment '(a b) '(1 2) env-0))
|
||||
(define env-2 (extend-environment '(c d) '(3 *unassigned*) env-1))
|
||||
|
||||
(define (scan-out-defines body)
|
||||
(cond
|
||||
((null? body) '())
|
||||
((definition? (car body)) (cons (car body) (scan-out-defines (cdr body))))
|
||||
(else (scan-out-defines (cdr body)))))
|
||||
|
||||
(define body '((define x 3)
|
||||
(if #t 1 2)
|
||||
(define b 2)))
|
||||
|
||||
(display (scan-out-defines body)) (newline)
|
||||
|
||||
(display "\nex-4.17\n")
|
||||
|
|
|
@ -18,6 +18,8 @@
|
|||
(else
|
||||
(error "Unknown expression type -- EVAL" exp))))
|
||||
|
||||
(define apply-in-underlying-scheme apply)
|
||||
|
||||
(define (apply procedure arguments)
|
||||
(cond ((primitive-procedure? procedure)
|
||||
(apply-primitive-procedure procedure arguments))
|
||||
|
@ -232,4 +234,67 @@
|
|||
(scan (frame-variables frame)
|
||||
(frame-values frame))))
|
||||
|
||||
'evaluator-loaded
|
||||
(define (primitive-procedure-objects)
|
||||
(map (lambda (proc) (list 'primitive (cadr proc)))
|
||||
primitive-procedures))
|
||||
|
||||
(define primitive-procedures
|
||||
(list (list 'car car)
|
||||
(list 'cdr cdr)
|
||||
(list 'cons cons)
|
||||
(list 'null? null?)
|
||||
(list 'display display)
|
||||
;;<more primitives>
|
||||
))
|
||||
|
||||
(define (primitive-procedure-names)
|
||||
(map car
|
||||
primitive-procedures))
|
||||
|
||||
(define (setup-environment)
|
||||
(let ((initial-env
|
||||
(extend-environment (primitive-procedure-names)
|
||||
(primitive-procedure-objects)
|
||||
the-empty-environment)))
|
||||
(define-variable! 'true true initial-env)
|
||||
(define-variable! 'false false initial-env)
|
||||
initial-env))
|
||||
(define the-global-environment (setup-environment))
|
||||
|
||||
(define (primitive-procedure? proc)
|
||||
(tagged-list? proc 'primitive))
|
||||
|
||||
(define (primitive-implementation proc) (cadr proc))
|
||||
|
||||
(define (apply-primitive-procedure proc args)
|
||||
(apply-in-underlying-scheme
|
||||
(primitive-implementation proc) args))
|
||||
|
||||
(define input-prompt ";;; M-Eval input:")
|
||||
(define output-prompt ";;; M-Eval value:")
|
||||
|
||||
(define (driver-loop)
|
||||
(prompt-for-input input-prompt)
|
||||
(let ((input (read)))
|
||||
(let ((output (eval input the-global-environment)))
|
||||
(announce-output output-prompt)
|
||||
(user-print output)))
|
||||
(driver-loop))
|
||||
|
||||
(define (prompt-for-input string)
|
||||
(newline) (newline) (display string) (newline))
|
||||
|
||||
(define (announce-output string)
|
||||
(newline) (display string) (newline))
|
||||
|
||||
(define (user-print object)
|
||||
(if (compound-procedure? object)
|
||||
(display (list 'compound-procedure
|
||||
(procedure-parameters object)
|
||||
(procedure-body object)
|
||||
'<procedure-env>))
|
||||
(display object)))
|
||||
|
||||
(define the-global-environment (setup-environment))
|
||||
|
||||
; (driver-loop)
|
||||
|
|
Loading…
Reference in New Issue