Serendip

Web Studio

問題4.4

まず、Gauche で and、or の単純なサンプルを作る。

(define (my-and exp)
  (define (my-and-iter exp result)
    (if (null? exp)
        result
        (if (car exp)
            (my-and-iter (cdr exp) (car exp))
            #f)))
  (if (null? exp)
      #t
      (my-and-iter exp '())))

(my-and '())
gosh> #t
(my-and '(1 2 3 4))
gosh> 4
(my-and '(1 2 3 #f))
gosh> #f
(my-and '(1 2 #f 4))
gosh> #f
(my-and '(#f #f #f #f))
gosh> #f

(define (my-or exp)
  (if (null? exp)
      #f
      (if (car exp)
          (car exp)
          (my-or (cdr exp)))))

(my-or '())
gosh> #f
(my-or '(1 2 3 4))
gosh> 1
(my-or '(#f 2 3 #f))
gosh> 2
(my-or '(#f #f #f 4))
gosh> 4
(my-or '(#f #f #f #f))
gosh> #f

このサンプルを元にして eval-and、eval-or を作る。

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ; 省略
        ((and? exp) (eval-and (and-clauses exp) env))
        ((or? exp) (eval-or (or-clauses exp) env))
        ; 省略
        (else
          (error "Unknown expression type -- EVAL" exp))))

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

(define (and-clauses exp) (cdr exp))

(define (and-first-exp exp) (car exp))

(define (and-rest-exps exp) (cdr exp))

(define (eval-and exp env)
  (define (eval-and-iter exp result)
    (if (null? exp)
        result
        (let ((first-eval (eval (and-first-exp exp) env))
              (rest (and-rest-exps exp)))
             (if (true? first-eval)
                 (eval-and-iter rest first-eval)
                 'false))))
  (if (null? exp)
      'true
      (eval-and-iter exp '())))

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

(define (or-clauses exp) (cdr exp))

(define (or-first-exp exp) (car exp))

(define (or-rest-exps exp) (cdr exp))

(define (eval-or exp env)
  (if (null? exp)
      'false
      (let ((first-eval (eval (or-first-exp exp) env))
            (rest (or-rest-exps exp)))
           (if (true? first-eval)
               first-eval
               (eval-or rest env)))))

実行結果

;;; M-Eval input:
(and)

;;; M-Eval value:
true

;;; M-Eval input:
(and '1)

;;; M-Eval value:
1

;;; M-Eval input:
(and '1 '2)

;;; M-Eval value:
2

;;; M-Eval input:
(and '1 '2 false)

;;; M-Eval value:
false

;;; M-Eval input:
(or)

;;; M-Eval value:
false

;;; M-Eval input:
(or '1)

;;; M-Eval value:
1

;;; M-Eval input:
(or '1 '2)

;;; M-Eval value:
1

;;; M-Eval input:
(or false '2 '3)

;;; M-Eval value:
2

;;; M-Eval input:

導出された式として評価する and、or

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ; 省略
        ((and? exp) (eval (and->if exp) env))
        ((or? exp) (eval (or->if exp) env))
        ; 省略
        (else
          (error "Unknown expression type -- EVAL" exp))))

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

(define (and-clauses exp) (cdr exp))

(define (and-first-exp exp) (car exp))

(define (and-rest-exps exp) (cdr exp))

(define (and->if exp)
  (expand-and-clauses (and-clauses exp)))

(define (expand-and-clauses clauses)
  (define (expand-and-iter clauses result)
    (if (null? clauses)
        result
        (let ((first (and-first-exp clauses))
              (rest (and-rest-exps clauses)))
             (make-if first
                 (expand-and-iter rest first)
                 'false))))
  (if (null? clauses)
      'true
      (expand-and-iter clauses '())))

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

(define (or-clauses exp) (cdr exp))

(define (or-first-exp exp) (car exp))

(define (or-rest-exps exp) (cdr exp))

(define (or->if exp)
  (expand-or-clauses (or-clauses exp)))

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

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る