2015/12/18

SICP 問題 4.04

;; and
(define (and? exp) (tagged-list? exp 'and))
(define (and-clauses exp) (cdr exp))

(define (eval-and exp env)
  (let iter ((clauses (and-clauses exp)))
    (if (null? clauses)
        'true
        (let ((first (eval (car clauses) env)))
          (cond ((null? (cdr clauses)) first)
                (first (iter (cdr clauses)))
                (else 'false))))))


;; or
(define (or? exp) (tagged-list? exp 'or))
(define (or-clauses exp) (cdr exp))

(define (eval-or exp env)
  (let iter ((clauses (or-clauses exp)))
    (if (null? clauses)
        'false
        (let ((first (eval (car clauses) env)))
          (cond ((null? (cdr clauses)) first)
                (first 'true)
                (else (iter (cdr clauses))))))))

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-valiable-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))
        ((and? exp) (eval-and (and-clauses exp) env))
        ((or? exp) (eval-or (or-clauses exp) env))
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        (else
         (error "Unknown expression type: EVAL" exp))))

;; 派生式としてのandとor
(define (and->if exp) (expand-and-clause (and-clauses exp)))
(define (expand-and-clause clauses)
  (if (null? clauses)
      'true
      (if (lst-exp? clauses)
          (first-exp clauses) ;;最後の式の値を返す.
          (make-if (first-exp clauses)
                   (expand-and-clause (rest-exps clauses))
                   'false))))

(define (or->if exp) (expand-or-clause (or-clauses exp)))
(define (expand-or-clause clauses)
  (if (null? clauses)
      'false
      (let ((first (first-exp clauses)))
        (make-if first
                 first
                 (expand-or-clause (rest-exps clauses))))))

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-valiable-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))
        ((and? exp) (eval (and->if exp) env))
        ((or? exp) (eval (or->if exp) env))
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        (else
         (error "Unknown expression type: EVAL" exp))))

© 2022 wat-aro