Browse Source

work on metacircular evaluator

canon
abraham levine 3 years ago
parent
commit
f98ed4b4e3
23 changed files with 726 additions and 6 deletions
  1. +6
    -6
      ch2/ex58.scm
  2. +33
    -0
      ch3/ex25.scm
  3. +36
    -0
      ch3/ex25.scm~
  4. +51
    -0
      ch4/evaluator-data-structures.scm
  5. +3
    -0
      ch4/evaluator-data-structures.scm~
  6. +23
    -0
      ch4/ex2.scm
  7. +93
    -0
      ch4/ex2.scm~
  8. +29
    -0
      ch4/ex3.scm
  9. +0
    -0
      ch4/ex3.scm~
  10. +56
    -0
      ch4/ex4.scm
  11. +28
    -0
      ch4/ex4.scm~
  12. +30
    -0
      ch4/ex5.scm
  13. +22
    -0
      ch4/ex5.scm~
  14. +7
    -0
      ch4/ex6.scm
  15. +2
    -0
      ch4/ex6.scm~
  16. +32
    -0
      ch4/ex7.scm
  17. +24
    -0
      ch4/ex7.scm~
  18. +11
    -0
      ch4/ex8.scm
  19. +10
    -0
      ch4/ex8.scm~
  20. +93
    -0
      ch4/representing-expressions.scm
  21. +51
    -0
      ch4/representing-expressions.scm~
  22. +64
    -0
      ch4/the-core-of-the-evaluator.scm
  23. +22
    -0
      ch4/the-core-of-the-evaluator.scm~

+ 6
- 6
ch2/ex58.scm View File

@@ -36,21 +36,21 @@
(else (list '+ a1 a2))))

(define (sum? x)
(eq? '+ (operation expr)))
(eq? '+ (operation x)))

(define (addend s)
(define (iter e result)
(if (eq? (car e) '+)
result
(iter (cdr e) (append result (list (car expr))))))
(let ((result (iter e '())))
(iter (cdr e) (append result (list (car e))))))
(let ((result (iter s '())))
(if (= (length result) 1)
(car result)
result)))

(define (augend s)
(let ((result (cdr (memq '+ expr))))
(if (= (length result 1))
(let ((result (cdr (memq '+ s))))
(if (= (length result) 1)
(car result)
result)))

@@ -62,7 +62,7 @@
(else (list '* m1 m2))))

(define (product? x)
(eq? '* (operation expr)))
(eq? '* (operation x)))

(define (multiplier p)
(define (iter e result)


+ 33
- 0
ch3/ex25.scm View File

@@ -0,0 +1,33 @@
(define (lookup keys table)
(define (helper remaining last)
(cond ((null? remaining)
(cdr last))
(else
(let ((next (assoc (car remaining) (cdr last))))
(if next
(helper (cdr remaining) next)
#f)))))
(helper keys table))

(define (insert! keys value table)
(define (helper remaining last)
(if (null? (cdr remaining))
(let ((record (assoc (car remaining) (cdr last))))
(if record
(set-cdr! record value)
(set-cdr! last
(cons (cons (car remaining) value)
(cdr last)))))
(let ((next (assoc (car remaining) (cdr last))))
(if next
(helper (cdr remaining) next)
(let ((new (list (car remaining))))
(set-cdr! last
(cons new
(cdr last)))
(helper (cdr remaining) new))))))
(helper keys table)
'ok)

(define (make-table)
(list '*table*))

+ 36
- 0
ch3/ex25.scm~ View File

@@ -0,0 +1,36 @@
(define (lookup key-1 key-2 table)
(let ((subtable
(assoc key-1 (cdr table))))
(if subtable
(let ((record
(assoc key-2 (cdr subtable))))
(if record
(cdr record)
#f))
#f)))

(define (insert! key value table)
(let ((record (assoc key (cdr table))))
(if record
(set-cdr! record value)
(set-cdr! table (cons (cons key value)
(cdr table)))))
'ok)

(define (insert! key-1 key-2 value table)
(let ((subtable (assoc key-1 (cdr table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! table
(cons (list key-1
(cons key-2 value))
(cdr table)))))
'ok)

(define (make-table)
(list '*table*))

+ 51
- 0
ch4/evaluator-data-structures.scm View File

@@ -0,0 +1,51 @@
;; conditionals
;; if something is true it is not false
(define (true? x)
(not (eq? x #f)))
(define (false? x)
(eq? x false))

;; procedures
;; assumes that (apply-priitive-procedure) and (primitive-procedure?)
;; exist
;; NOT scheme standard, will be implemented later

(define (make-procedure params body env)
(list 'procedure params body env))
(define (compound-procedure? p)
(tagged-list? p 'procedure))
(define (procedure-parameters p) (cadr p))
(define (procedure-body p) (caddr p))
(define (procedure-environment p) (cadddr p))

;; MANIPULATION OF ENVIRONMENTS
;;
;; (lookup-variable-value var env)
;; returns value bound to symbol var in environment env
;; signals error if unbound
;;
;; (extend-environment variables values base-env)
;; returns a new environment with a new frame where the list of
;; variables is bound to the list of values sequentially, with an
;; enclosing environment base-env
;;
;; (define-variable! var value env)
;; adds to the first frame in evironment env a binding where var is
;; assigned to value
;;
;; (set-variable-value! var value env)
;; changes binding of variable var in environment env so variable is now
;; bound to the new value
;; signals error if unbound

(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define the-empty-environment '())

(define (make-frame variables values)
(cons variables values))
(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))
(define (add-binding-to-frame! var val frame)
(set-car! frame (cons var (car frame)))
(set-cdr! frame (cons val (cdr frame))))

+ 3
- 0
ch4/evaluator-data-structures.scm~ View File

@@ -0,0 +1,3 @@
;; conditionals
(define (true? x)
(not (eq? x #f)))

+ 23
- 0
ch4/ex2.scm View File

@@ -0,0 +1,23 @@
;; seriously?
;; issues: the evaluator will attempt to look for a function (define) and
;; fail to find it -- special forms don't work without explicit function
;; syntax

(define (eval exp env)
(cond ((self-evaluating? exp) exp)
;; ...
((application? exp)
(apply (eval (operator exp) env)
(list-of-values (operands exp) env)))
((assignment? exp) (eval-assignment exp env))
;; ...
(else
(error "Unknown expression type -- EVAL" exp))))

;; ...


;; god I hate this idea with a burning passion
(define (application? exp) (tagged-list? exp 'call))
(define (operator exp) (cadr exp))
(define (operands exp) (cddr exp))

+ 93
- 0
ch4/ex2.scm~ View File

@@ -0,0 +1,93 @@
(define (self-evaluating? exp)
(cond ((number? exp) #t)
((string? exp) #t)
(else #f)))

(define (variable? exp) (symbol? exp))

(define (quoted? exp)
(tagged-list? exp 'quote))

(define (text-of-quotation exp) (cadr exp))

(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
#f))

(define (assignment? exp)
(tagged-list? exp 'set!))
(define (assignment-variable exp) (cadr exp))
(define (assignment-variable exp) (caddr exp))

(define (definition? exp)
(tagged-list? exp 'define))
(define (definition-variable exp)
(if (symbol? (cadr exp))
(cadr exp)
(caadr exp)))
(define (definition-value exp)
(if (symbol? (cadr exp))
(caddr exp)
(make-lambda (cdadr exp)
(cddr exp))))

(define (lambda? exp) (tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
(define (lambda-body exp) (cddr exp))

(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))

(define (if? exp) (tagged-list? exp 'if))
(define (if-predicate exp) (cadr exp))
(define (if-consequent exp) (caddr exp))
(define (if-alternative exp)
(if (not (null? (cdddr exp)))
(cadddr exp)
'#f))

(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))

(define (begin? exp) (tagged-list? exp 'begin))
(define (begin-actions exp) (cdr exp))
(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))

(define (sequence->exp seq)
(cond ((null? seq) seq)
((last-exp? seq) (first-exp seq))
(else (make-begin seq))))
(define (make-begin seq) (cons 'begin seq))

(define (application? exp) (pair? exp))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operands ops) (cdr ops))

(define (cond? exp) (tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
(define (cond-predicate cause) (car clause))
(define (cond-actions clause) (cdr clause))
(define (cond->if exp)
(expand-clauses (cond-clauses exp)))

(define (expand-clauses clauses)
(if (null? clauses)
#f
(let ((first (car clauses))
(rest (cdr clauses)))
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last -- COND->IF"
clauses))
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest))))))

+ 29
- 0
ch4/ex3.scm View File

@@ -0,0 +1,29 @@
;; use table implementation from 3.3.3
(define (operation-table (make-table)))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

;; cannot represent variables, self-evaluation, or application without
;; literal syntax in this manner
(put 'op 'quote text-of-quotation)
(put 'op 'set! eval-assignment)
(put 'op 'define eval-definition)
(put 'op 'if eval-if)
(put 'op 'lambda (lambda (x y)
(make-procedure (lambda-parameters x)
(lambda-body y)
y)))
(put 'op 'begin (lambda (x y)
(eval-sequeence (begin-actions x) y)))
(put 'op 'cond (lambda (x y)
(eval (cond->if x) y)))

(define (eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((get 'op (car expr)) (apply (get 'op (car expr) expr env)))
((application? exp)
(apply (eval (operator exp) env)
(list-of-values (operands exp) env)))
(else
(error "Unknown expression type -- EVAL" exp))))

+ 0
- 0
ch4/ex3.scm~ View File


+ 56
- 0
ch4/ex4.scm View File

@@ -0,0 +1,56 @@
(define (operation-table (make-table)))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

;; cannot represent variables, self-evaluation, or application without
;; literal syntax in this manner
(put 'op 'quote text-of-quotation)
(put 'op 'set! eval-assignment)
(put 'op 'define eval-definition)
(put 'op 'if eval-if)
(put 'op 'and eval-and)
(put 'op 'or eval-or)
(put 'op 'lambda (lambda (x y)
(make-procedure (lambda-parameters x)
(lambda-body y)
y)))
(put 'op 'begin (lambda (x y)
(eval-sequeence (begin-actions x) y)))
(put 'op 'cond (lambda (x y)
(eval (cond->if x) y)))

(define (eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((get 'op (car expr)) (apply (get 'op (car expr) expr env)))
((application? exp)
(apply (eval (operator exp) env)
(list-of-values (operands exp) env)))
(else
(error "Unknown expression type -- EVAL" exp))))

(define (and? exp) (tagged-list? exp 'and))
(define (and-clauses exp) (cdr exp))
(define (eval-and exp env)
(let ((val (eval (first-exp exp) env)))
(if (last-exp? exp)
(if val
val
#f)
(else
(if val
(eval-and (rest-exps exp) env)
#f)))))

(define (or? exp) (tagged-list? exp 'or))
(define (or-clauses exp) (cdr exp))
(define (eval-or exp env)
(let ((val (eval (first-exp exp) env)))
(if (last-exp? exp)
(if v
v
#f)
(else
(if v
v
(eval-or (rest-exps exp) env))))))

+ 28
- 0
ch4/ex4.scm~ View File

@@ -0,0 +1,28 @@
(define (operation-table (make-table)))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

;; cannot represent variables, self-evaluation, or application without
;; literal syntax in this manner
(put 'op 'quote text-of-quotation)
(put 'op 'set! eval-assignment)
(put 'op 'define eval-definition)
(put 'op 'if eval-if)
(put 'op 'lambda (lambda (x y)
(make-procedure (lambda-parameters x)
(lambda-body y)
y)))
(put 'op 'begin (lambda (x y)
(eval-sequeence (begin-actions x) y)))
(put 'op 'cond (lambda (x y)
(eval (cond->if x) y)))

(define (eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((get 'op (car expr)) (apply (get 'op (car expr) expr env)))
((application? exp)
(apply (eval (operator exp) env)
(list-of-values (operands exp) env)))
(else
(error "Unknown expression type -- EVAL" exp))))

+ 30
- 0
ch4/ex5.scm View File

@@ -0,0 +1,30 @@
(define (cond? exp) (tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
(define (cond-predicate clause) (car clause))
(define (cond-actions clause) (cdr clause))
(define (cond->if exp)
(expand-clauses (cond-clauses exp)))
(define (extended-cond? clause) (eq? (cadr clause) '=>))
(define (extended-cond-test clause) (car clause))
(define (extended-cond-recipient clause) (caddr clause))

(define (expand-clauses clauses)
(if (null? clauses)
#f
(let ((first (car clauses))
(rest (cdr clauses)))
(cond ((cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last -- COND->IF" clauses)))
((extended-cond-syntax first)
(make-if (extended-cond-test first)
(list (extended-cond-recipient first)
(extended-cond-test first))
(expand-clauses rest)))
(else
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest)))))))

+ 22
- 0
ch4/ex5.scm~ View File

@@ -0,0 +1,22 @@
(define (cond? exp) (tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
(define (cond-predicate cause) (car clause))
(define (cond-actions clause) (cdr clause))
(define (cond->if exp)
(expand-clauses (cond-clauses exp)))

(define (expand-clauses clauses)
(if (null? clauses)
#f
(let ((first (car clauses))
(rest (cdr clauses)))
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last -- COND->IF"
clauses))
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest))))))

+ 7
- 0
ch4/ex6.scm View File

@@ -0,0 +1,7 @@
(define (let? exp) (tagged-list? exp 'let))
(define (let-variables exp) (map car (cadr exp)))
(define (let-initializers exp) (map cadr (cadr exp)))
(define (let-body exp) (cddr exp))
(define (let->combination exp)
(cons (make-lambda (let-vars expr) (let-body expr))
(let-inits expr)))

+ 2
- 0
ch4/ex6.scm~ View File

@@ -0,0 +1,2 @@
(define (let? exp) (tagged-list? exp 'let))
(define (let-vars exp) (car exp))

+ 32
- 0
ch4/ex7.scm View File

@@ -0,0 +1,32 @@
;; (let* ((x 3)
;; (y (+ x 2))
;; (z (+ x y 5)))
;; (* x z))
;;
;; ==
;;
;; (let ((x 1))
;; (let (y (+ x 2))
;; (let (z (+ x y 5))
;; (* x z))))

;; ex6
(define (let? exp) (tagged-list? exp 'let))
(define (let-definitions exp) (cadr exp))
(define (let-variable def) (car def))
(define (let-initializer def) (cadr def))
(define (let-variables exp) (map let-variable (let-definitions exp)))
(define (let-initializers exp) (map let-initializer (let-definitions exp)))
(define (let-body exp) (cddr exp))
(define (let->combination exp)
(cons (make-lambda (let-vars expr) (let-body expr))
(let-inits expr)))

(define (let*? exp) (tagged-list? exp 'let*))
(define (let*->nexted-lets exp)
(let ((inits (let-initializers exp))
(body (let-body exp)))
((lambda (exps)
(if (null? exps)
body
(list 'let (list (car exps)) (make-lets (cdr exps))))) inits)))

+ 24
- 0
ch4/ex7.scm~ View File

@@ -0,0 +1,24 @@
;; (let* ((x 3)
;; (y (+ x 2))
;; (z (+ x y 5)))
;; (* x z))
;;
;; ==
;;
;; (let ((x 1))
;; (let (y (+ x 2))
;; (let (z (+ x y 5))
;; (* x z))))

;; ex6
(define (let? exp) (tagged-list? exp 'let))
(define (let-variables exp) (map car (cadr exp)))
(define (let-initializers exp) (map cadr (cadr exp)))
(define (let-body exp) (cddr exp))
(define (let->combination exp)
(cons (make-lambda (let-vars expr) (let-body expr))
(let-inits expr)))

(define (let*? exp) (tagged-list? exp 'let*))
(define (let*->nexted-lets exp)
(expand-))

+ 11
- 0
ch4/ex8.scm View File

@@ -0,0 +1,11 @@
(define (let? exp) (tagged-list? exp 'let))
(define (let-definitions exp) (cadr exp))
(define (let-variable def) (car def))
(define (let-initializer def) (cadr def))
(define (let-variables exp) (map let-variable (let-definitions exp)))
(define (let-initializers exp) (map let-initializer (let-definitions exp)))
(define (let-body exp) (cddr exp))

(define (let->combination exp)
(cons (make-lambda (let-vars expr) (let-body expr))
(let-inits expr)))

+ 10
- 0
ch4/ex8.scm~ View File

@@ -0,0 +1,10 @@
(define (let? exp) (tagged-list? exp 'let))
(define (let-definitions exp) (cadr exp))
(define (let-variable def) (car def))
(define (let-initializer def) (cadr def))
(define (let-variables exp) (map let-variable (let-definitions exp)))
(define (let-initializers exp) (map let-initializer (let-definitions exp)))
(define (let-body exp) (cddr exp))
(define (let->combination exp)
(cons (make-lambda (let-vars expr) (let-body expr))
(let-inits expr)))

+ 93
- 0
ch4/representing-expressions.scm View File

@@ -0,0 +1,93 @@
(define (self-evaluating? exp)
(cond ((number? exp) #t)
((string? exp) #t)
(else #f)))

(define (variable? exp) (symbol? exp))

(define (quoted? exp)
(tagged-list? exp 'quote))

(define (text-of-quotation exp) (cadr exp))

(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
#f))

(define (assignment? exp)
(tagged-list? exp 'set!))
(define (assignment-variable exp) (cadr exp))
(define (assignment-variable exp) (caddr exp))

(define (definition? exp)
(tagged-list? exp 'define))
(define (definition-variable exp)
(if (symbol? (cadr exp))
(cadr exp)
(caadr exp)))
(define (definition-value exp)
(if (symbol? (cadr exp))
(caddr exp)
(make-lambda (cdadr exp)
(cddr exp))))

(define (lambda? exp) (tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
(define (lambda-body exp) (cddr exp))

(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))

(define (if? exp) (tagged-list? exp 'if))
(define (if-predicate exp) (cadr exp))
(define (if-consequent exp) (caddr exp))
(define (if-alternative exp)
(if (not (null? (cdddr exp)))
(cadddr exp)
'#f))

(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))

(define (begin? exp) (tagged-list? exp 'begin))
(define (begin-actions exp) (cdr exp))
(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))

(define (sequence->exp seq)
(cond ((null? seq) seq)
((last-exp? seq) (first-exp seq))
(else (make-begin seq))))
(define (make-begin seq) (cons 'begin seq))

(define (application? exp) (pair? exp))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operands ops) (cdr ops))

(define (cond? exp) (tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
(define (cond-predicate cause) (car clause))
(define (cond-actions clause) (cdr clause))
(define (cond->if exp)
(expand-clauses (cond-clauses exp)))

(define (expand-clauses clauses)
(if (null? clauses)
#f
(let ((first (car clauses))
(rest (cdr clauses)))
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last -- COND->IF"
clauses))
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest))))))

+ 51
- 0
ch4/representing-expressions.scm~ View File

@@ -0,0 +1,51 @@
(define (self-evaluating? exp)
(cond ((number? exp) #t)
((string? exp) #t)
(else #f)))

(define (variable? exp) (symbol? exp))

(define (quoted? exp)
(tagged-list? exp 'quote))

(define (text-of-quotation exp) (cadr exp))

(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
#f))

(define (assignment? exp)
(tagged-list? exp 'set!))
(define (assignment-variable exp) (cadr exp))
(define (assignment-variable exp) (caddr exp))

(define (definition? exp)
(tagged-list? exp 'define))
(define (definition-variable exp)
(if (symbol? (cadr exp))
(cadr exp)
(caadr exp)))
(define (definition-value exp)
(if (symbol? (cadr exp))
(caddr exp)
(make-lambda (cdadr exp)
(cddr exp))))

(define (lambda? exp) (tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
(define (lambda-body exp) (cddr exp))

(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))

(define (if? exp) (tagged-list? exp 'if))
(define (if-predicate exp) (cadr exp))
(define (if-consequent exp) (caddr exp))
(define (if-alternative exp)
(if (not (null? (cdddr exp)))
(cadddr exp)
'#f))

(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))

+ 64
- 0
ch4/the-core-of-the-evaluator.scm View File

@@ -0,0 +1,64 @@
;; implemented as case analysis for simplicity
;; should be implemented using object orientation

(define (eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((quoted? exp) (text-of-quotation exp))
((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))
((applicaton? exp)
(apply (eval (operator exp) env)
(list-of-values (operands exp) env)))
(else
(error "Unknown expression type -- EVAL" exp))))

(define (apply procedure arguments)
(cond ((primitive-procedure? procedure)
(apply-primitive-proccedure procedure arguments))
((compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure)
arguments
(procedure-environment procedure))))
(else
(error
"Unknown procedure type -- APPLY" procedure))))

(define (list-of-values exps env)
(if (no-operands? exps)
'()
(cons (eval (first-operand exps) env)
(list-of-values (rest-operands exps) env))))

(define (eval-if exp env)
(if (true? (eval (if-predicate exp) env))
(eval (if-consequent exp) env)
(eval (if-alternative exp) env)))

(define (eval-sequence exps env)
(cond ((last-exp? exps) (eval (first-exp exps) env))
(else (eval (first-exp exps) env)
(eval-sequence (rest-exps exps) env))))

(define (eval-assignment exp env)
(set-variable-value! (assignment-variable exp)
(eval (assignment-value exp) env)
env)
'ok)

(define (eval-definition exp env)
(define-variable! (definition-variable exp)
(eval (definition value exp) env)
env)
'ok)

+ 22
- 0
ch4/the-core-of-the-evaluator.scm~ View File

@@ -0,0 +1,22 @@
;; implemented as case analysis for simplicity
;; should be implemented using object orientation

(define (eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((quoted? exp) (text-of-quotation exp))
((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))
((applicaton? exp)
(apply (eval (operator exp) env)
(list-of-values (operands exp) env)))
(else
(error "Unknown expression type -- EVAL" exp))))

Loading…
Cancel
Save