4.1.2表达式的表示

来源:互联网 发布:佳能mp228清零软件 编辑:程序博客网 时间:2024/06/07 10:19
;4.3(load "table.scm")(define (eval-1 exp env)  (cond ((self-evaluating? exp) exp)        ((variable? exp) (lookup-variable-value exp env))        ((get 'exp (car exp)) ((get 'exp (car exp)) exp env))        ((application? exp)         (apply (eval (operator exp))                (list-of-values (operands exp) env)))        (else (error "Unknown expression type -- EVAL" exp))))(put 'exp 'quote (lambda (exp env) (text-of-quotation exp)))(put 'exp 'set! eval-assignment)(put 'exp 'define eval-definition)(put 'exp 'if eval-if)(put 'exp 'lambda     (lambda (exp env)       (make-procedure (lambda-parameters exp)                       (lambda-body exp)                       env)))(put 'exp 'begin     (lambda (exp env)       (eval-sequence (begin-actions exp) env)))(put 'exp 'cond     (lambda (exp env) (eval (cond->if exp) exp)));4.4;special form(define (no-exps? exps) (null? exps))(define (eval-and exp env)  (define (eval-and-iter exps)    (cond ((no-exps? exps) 'true)          ((false? (eval (first-exp exps) env)) 'false)          (else (eval-and-iter (rest-exps exps)))))  (eval-and-iter (operands exp)))(put 'exp 'and eval-and)(define (eval-or exp env)  (define (eval-or-iter exps)    (cond ((no-exps? exps) 'false)          ((true? (eval (first-exp exps) env)) 'true)          (else (eval-or-iter (rest-exps exps)))))  (eval-or-iter (operands exp)))(put 'exp 'or eval-or);derived form(define (and->if exp)  (expand-and-clauses (cdr exp)))(define (expand-and-clauses clauses)  (if (null? clauses)      'true      (make-if (car clauses)               (expand-and-clauses (cdr clauses))               'false)))(define (eval-and-2 exp env)  (eval-if (and->if exp) env))(define (or->if exp)  (expand-or-clauses (cdr exp)))(define (expand-or-clauses clauses)  (if (null? clauses)      'false      (make-if (car clauses)               'true               (expand-or-clauses (cdr clauses)))))(define (eval-or-2 exp env)  (eval-if (or->if exp) env));4.5(define (expand-clauses-2 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))            (if (eq? (cadr first) '=>)                (cons (make-lambda                       '(x)                       (list (make-if 'x                                  (list (caddr first) 'x)                                  (expand-clauses-2 rest))))                      (list (cond-predicate first)))                (make-if (cond-predicate first)                         (sequence->exp (cond-actions first))                         (expand-clauses-2 rest)))))));4.6(define (let? exp)  (tagged-list? exp 'let))(define (let->combination exp)  (cons   (make-lambda    (map car (cadr exp))    (cddr exp))   (map cadr (cadr exp))));4.7(define (let*? exp)  (tagged-list? exp 'let*))(define (make-let bindings body)  (cons 'let (cons bindings body)))(define (let*->nested-lets exp)  (define (rec bindings)    (cond ((null? bindings) (cddr exp))          ((last-exp? bindings)           (make-let (list (car bindings))                     (cddr exp)))          (else (make-let                 (list (car bindings))                 (list (rec (cdr bindings)))))))  (rec (cadr exp)));4.8;;the example can be transformed into the following form:;; (define (fib n);;   (let ((a 1);;         (b 0);;         (count n));;       (define (fib-iter a b count);;         (if (= count 0);;             b;;             (fib-iter (+ a b) a (- count 1))));;       (fib-iter a b count)))(define (make-definition head body)  (cons 'define (cons head body)))(define (let->combination-2 exp)  (if (pair? (cadr exp))      (cons       (make-lambda        (map car (cadr exp))        (cddr exp))       (map cadr (cadr exp)))      (let* ((vars (map car (caddr exp)))             (proc (cadr exp))             (head (cons proc vars))             (body (cdddr exp)))        (make-let         (caddr exp)         (list          (make-definition head body)          head)))))
0 0