計算機プログラムの構造と解釈　第二版 P226 問題4.12

sicp

手続きの一部を抽象化しろという話。
対象となる手続きは

  • set-variable-value!
  • define-variable!
  • lookup-variable-value

この三つの手続きの内側に既に明らかに似ている(hoge手続きが同じ名前(scan)で定義されてる。
こいつを抽象化すれば良いのかなと思う。

lookup-variableのscan

 (define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
             (car vals))
            (else (scan (cdr vars) (cdr vals)))))

set-variable-value!のscan

(define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
             (set-car! vals val))
            (else (scan (cdr vars) (cdr vals)))))

define-variable!のスキャン

(define (scan vars vals)
      (cond ((null? vars)
             (add-binding-to-frame! var val frame))
            ((eq? var (car vars))
             (set-car! vals val))
            (else (scan (cdr vars) (cdr vals)))))

大体、共通性が見える。
null?の時は'()を返して、
eq? var の時はvalsを返せば良さそう。

そうすると、scanはこんな感じか

(define (scan vars vals)
      (cond ((null? vars) '())
            ((eq? var (car vars)) vals)
            (else (scan (cdr vars) (cdr vals)))))

実装

#!/usr/local/bin/gosh
;; -*- coding: utf-8 -*-

;;;実装
(load "./modules/4th.scm")
(load "./modules/let.scm")


(define (scan var vars vals)
  (cond ((null? vars) '())
        ((eq? var (car vars)) vals)
        (else
          (scan var (cdr vars) (cdr vals)))))

(define (lookup-variable-value var env)
  (define (env-loop env)
    (if (eq? env the-empty-environment)
      (error "Unbound variable" var)
      (let ((frame (first-frame env)))
        (let ((result (scan var (frame-variables frame) (frame-values frame))))
          (if (null? result)
            (env-loop (enclosing-environment env))
            (car result))))))
  (env-loop env))

(define (set-variable-value! var val env)
  (define (env-loop env)
    (if (eq? env the-empty-environment)
      (error "Unbound variable -- SET!" var)
      (let ((frame (first-frame env)))
        (let ((result (scan var (frame-variables frame) (frame-values frame))))
          (if (null? result)
            (env-loop (enclosing-environment env))
            (set-car! result val))))))
  (env-loop env))

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (let ((result (scan var (frame-variables frame) (frame-values frame))))
      (if (null? result)
        (add-binding-to-frame! var val frame)
        (set-car! result val)))))


(define the-global-environment (setup-environment))
(driver-loop)


実行

;;; M-Eval input:
(define (hoge x)
(let ((y 100) (z 2))
(+ y (* x z))))

;;; M-Eval value:
ok

;;; M-Eval input:
(hoge 1)

;;; M-Eval value:
102