問題4.4
(define (eval-and-sequence exps env) (if (null? exps) 'true (if (true? (eval (first-exp exps) env)) (eval-and-sequence (rest-exps exps) env) 'false))) (define (eval-and exp env) (eval-and-sequence (cdr exp) env)) (put 'eval 'and eval-and) (define (eval-or-sequence exps env) (if (null? exps) 'false (if (true? (eval (first-exp exps) env)) 'true (eval-and-sequence (rest-exps exps) env)))) (define (eval-or exp env) (eval-or-sequence (cdr exp) env)) (put 'eval 'or eval-or)
問題4.3
(define (eval exp env) (cond ((self-evaluationg? exp) exp) ((variable? exp) (lookup-variable-value exp env)) (else (let ((proc (get 'eval (car exp)))) (if proc (proc exp env) (if (application? exp) (apply (eval (operator exp) env) (list-of-values (operands exp) env)) (error "Unknown expression type -- EVAL " exp))))))) (define (install-eval-package) ;; quote (define (text-of-quotation exp env) (cadr exp)) ;; set! (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (eval (assignment-value exp) env) env)) ;; define (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caddr exp))) (define (eval-definition exp env) (define-variable! (definition-variable exp) (eval (definition-value exp) env) env) 'ok) ;; eval-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 (eval-if exp env) (if (true? (eval (if-predicate exp) env)) (eval (if-consequent exp) env) (eval (if-alternative exp) env))) ;; lambda (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (define (eval-lambda exp env) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ;; begin (define (last-exp? seq (null? (cdr seq)))) (define (first-exp seq) (car seq)) (define (rest-exps seq) (cdr seq)) (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 (begin-actions exp) (cdr exp)) (define (eval-begin exp env) (eval-sequence (begin-actions exp) env)) ;; cond (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (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)))))) (define (eval-cond exp env) (eval (cond->if exp) env)) (put 'eval 'quote text-of-quotation) (put 'eval 'set! eval-assignment) (put 'eval 'define eval-definition) (put 'eval 'if eval-if) (put 'eval 'lambda eval-lambda) (put 'eval 'begin eval-begin) (put 'eval 'cond eval-cond)) (define (make-table) (let ((local-table (list '*table*))) (define (lookup key-1 key-2) (let ((subtable (assoc key-1 (cdr local-table)))) (if subtable (let ((record (assoc key-2 (cdr subtable)))) (if record (cdr record) #f)) #f))) (define (insert! key-1 key-2 value) (let ((subtable (assoc key-1 (cdr local-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! local-table (cons (list key-1 (cons key2 value)) (cdr local-table))))) 'ok) (define (dispatch m) (cond ((eq? m 'lookup-proc) lookup) ((eq? m 'insert-proc!) insert!) (else (error "Unknown operation -- TABLE" m)))) dispatch)) (define the-table (make-table)) (define get (the-table 'lookup-proc)) (define put (the-table 'insert-proc!))
問題4.2
(define (eval exp env) (cond ((self-evaluationg? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((call? exp) (apply (eval (operator exp) env) (list-of-values (operands 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)) (else (error "Unknown expression type -- EVAL" exp)))) (define (call? exp) (tagged-list? exp 'call))
問題4.1
;; 4.1 ;L->R (define (list-of-values exps env) (if (no-operands? exps) '() (let ((val (eval (first-operand exps) env))) (cons val (list-of-values (rest-operands exps) env))))) ;R->L (define (list-of-values exps env) (if (no-operands? exps) '() (let ((val (list-of-values (rest-operands exps) env))) (cons (eval (first-operand exps) env) val))))
問題3.37
(define (subtracter a b c) (adder c b a)) (define (divider a b c) (multiplier c b a)) (define (c+ x y) (let ((z (make-connector))) (adder x y z) z)) (define (c- x y) (let ((z (make-connector))) (subtracter x y z) z)) (define (c* x y) (let ((z (make-connector))) (multiplier x y z) z)) (define (c/ x y) (let ((z (make-connector))) (divider x y z) z)) (define (cv x) (let ((y (make-connector))) (constant x y) y)) ;;;;;;; test (define (celsius-fahrenheit-converter x) (c+ (c* (c/ (cv 9) (cv 5)) x) (cv 32))) (define C (make-connector)) (define F (celsius-fahrenheit-converter C)) (probe "Celsius temp" C) (probe "Fahrenheit temp" F) (set-value! C 25 'user) ;Probe: Celsius temp = 25 ;Probe: Fahrenheit temp = 77 ;done (set-value! F 212 'user) ;*** ERROR: Contradiction (77 212) (forget-value! C 'user) ;Probe: Celsius temp = ? ;Probe: Fahrenheit temp = ? ;done (set-value! F 212 'user) ;Probe: Fahrenheit temp = 212 ;Probe: Celsius temp = 100 ;done ;;ok!!
