Fixes for 4.1

This commit is contained in:
Correl Roush 2015-01-11 17:15:10 -05:00
parent 30c8a6c26a
commit 12574b8345

46
4-1.org
View file

@ -51,6 +51,7 @@ make the evaluator independent of the representation of the language.
#+END_SRC #+END_SRC
** Apply ** Apply
#+BEGIN_SRC scheme :tangle yes #+BEGIN_SRC scheme :tangle yes
(define apply-in-underlying-scheme apply)
(define (apply procedure arguments) (define (apply procedure arguments)
(cond ((primitive-procedure? procedure) (cond ((primitive-procedure? procedure)
(apply-primitive-procedure (apply-primitive-procedure
@ -103,7 +104,7 @@ yields expansion of consciousness without the abuse of substance.
env)))) env))))
#+END_SRC #+END_SRC
** Assignments and definitions ** Assignments and definitions
#+BEGIN_SRC scheme #+BEGIN_SRC scheme :tangle yes
(define (eval-assignment exp env) (define (eval-assignment exp env)
(set-variable-value! (set-variable-value!
(assignment-variable exp) (assignment-variable exp)
@ -138,20 +139,18 @@ from right to left.
(define (list-of-values-ltr exps env) (define (list-of-values-ltr exps env)
(if (no-operands? exps) (if (no-operands? exps)
'() '()
(begin (let ((first (eval (first-operand exps) env))
(define first (eval (first-operand exps) env)) (rest (list-of-values-ltr
(define rest (list-of-values-ltr
(rest-operands exps) (rest-operands exps)
env)) env)))
(cons first rest)))) (cons first rest))))
(define (list-of-values-rtl exps env) (define (list-of-values-rtl exps env)
(if (no-operands? exps) (if (no-operands? exps)
'() '()
(begin (let ((rest (list-of-values-rtl
(define rest (list-of-values-rtl
(rest-operands exps) (rest-operands exps)
env)) env))
(define first (eval (first-operand exps) env)) (first (eval (first-operand exps) env)))
(cons first rest)))) (cons first rest))))
#+END_SRC #+END_SRC
* <<4.1.2>> Representing Expressions * <<4.1.2>> Representing Expressions
@ -824,20 +823,6 @@ Scheme by modifying the procedures in this section, without changing
(frame-values frame)))) (frame-values frame))))
#+END_SRC #+END_SRC
* <<4.1.4>> Running the Evaluator as a Program * <<4.1.4>> Running the Evaluator as a Program
#+BEGIN_SRC scheme :tangle yes
(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))
#+END_SRC
#+BEGIN_SRC scheme :tangle yes #+BEGIN_SRC scheme :tangle yes
(define (primitive-procedure? proc) (define (primitive-procedure? proc)
(tagged-list? proc 'primitive)) (tagged-list? proc 'primitive))
@ -851,7 +836,8 @@ Scheme by modifying the procedures in this section, without changing
(list 'cdr cdr) (list 'cdr cdr)
(list 'cons cons) (list 'cons cons)
(list 'null? null?) (list 'null? null?)
⟨more primitives⟩ )) ;; ⟨more primitives⟩
))
(define (primitive-procedure-names) (define (primitive-procedure-names)
(map car primitive-procedures)) (map car primitive-procedures))
@ -861,6 +847,20 @@ Scheme by modifying the procedures in this section, without changing
(list 'primitive (cadr proc))) (list 'primitive (cadr proc)))
primitive-procedures)) primitive-procedures))
#+END_SRC #+END_SRC
#+BEGIN_SRC scheme :tangle yes
(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))
#+END_SRC
#+BEGIN_SRC scheme :tangle yes #+BEGIN_SRC scheme :tangle yes
(define (apply-primitive-procedure proc args) (define (apply-primitive-procedure proc args)
(apply-in-underlying-scheme (apply-in-underlying-scheme