SICP問題4.9

SICP

2010/03/17 while?の定義の部分が間違ってたので修正

do,for,while,untilといった反復構造を設計し、その使用例を示し、それを導出された式としてどう実装するのか示せということだが、Schemeのdo構文が分かりづらいのでwhileの実装を考えてみる

(while <predicate> <body>)

という感じで、が真でなくなったらループを抜ける
使い方はこんな感じ

(let ((n 10)
      (i 0)
      (counter 0))
  (while (< counter n)
    (begin
      (set! counter (+ counter 1))
      (set! i (+ i counter))))
  (display i))
; 55

これは

(let ((n 10)
      (i 0)
      (counter 0))
  (let loop ()
    (if (< counter n)
        (begin
          (begin
            (set! counter (+ counter 1))
            (set! i (+ i counter)))
          (loop))))
  (display i))
; 55

に書き直しが可能なので以下のように実装。

(define (while? exp) (tagged-list? exp 'while))
(define (while-predicate exp) (cadr exp))
(define (while-body exp) (cddr exp))
(define (make-named-let name parameters body)
  (list 'let name parameters body))
(define (while->named-let exp)
  (make-named-let 'while-loop
                  '()
                  (make-if (while-predicate exp)
                           (make-begin
                            (list (car (while-body exp))
                                  '(while-loop)))
                           '())))
; eval
(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp))
        ((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))
        ((let? exp) (eval (let->combination exp) env))
        ((let*? exp) (eval (let*->nested-lets exp) env))
        ((while? exp) (eval (while->named-let exp) env)) ; 追加
        ((begin? exp)
         (eval-sequence (begin-actions exp) env))
        ((cond? exp) (eval (cond->if exp) env))
        ((and? exp) (eval-and exp env))
        ((or? exp) (eval-or exp env))
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        (else
         (error "Unknown expression type -- EVAL" exp))))