SICP 4.1.3-5

4.11

教科書の実装ではフレームは

 ((var1 var2 var3) (val1 val2 val3))

となっているのを

((var1 val1) (var2 val2) (var3 val3))

と実装し直す。

#lang racket

;変更なし
(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define the-empty-environment '())

;変更あり
(define (make-frame variables values)
  (map cons variables values))

(define (make-binding var val) (cons var val))
(define (add-binding-to-fram! var val frame)
  (set! frame (cons (make-binding var val) frame)))
(define (first-binding frame) (car frame))
(define (rest-bindings frame) (cdr frame))
(define (binding-var binding) (car binding))
(define (binding-val binding) (car binding))
(define (set-binding-val! binding val) (set-cdr! binding val))

;frame-vars と frame-vals を定義しても良いが、こっちの方が綺麗なので直す
(define (lookup-variable-value var env)
  (define (env-loop env)
    (define (scan frame)
      (if (null? frame)
          (env-loop (enclosing-environment env))
          (let ((binding (first-binding frame)))
              (if (eq? var (binding-var binding))
                  (binding-val binding)
                  (scan (rest-bindings frame))))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan frame))))
  (env-loop env))

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

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (define (scan frame)
      (if (null? frame)
          (add-binding-to-frame! var val frame)
          (let ((binding (first-binding frame)))
            (if (eq? var (binding-var binding))
                (set-binding-val! binding val)
                (scan (rest-bindings frame))))))
    (scan frame)))

4.12

scan と env-loop を抜き出す。

どちらも、対応する bindingを見つけたらそれを返す。 見つけられなかったら #f を返す。

教科書の実装と4.11の実装、両方に対応する抽象化をしたかったが断念。。。

(define (env-loop env var)
   (if (eq? env the-empty-environment)
        #f
        (let ((result (scan (first-frame env) var)))
          (if (result)
              result ;binding
              (env-loop (enclosing-environment env) var)))))

(define (scan frame var)
   (if (null? frame)
       #f
       (let ((binding (first-binding frame)))
         (if (eq? var (binding-var binding))
             binding
             (scan (rest-bindings frame))))))

(define (lookup-variable-value var env)
  (let ((result (env-loop env)))
     (if result
         (binding-val result)
         (error "Unbound variable" var))))

(define (set-variable-value! var val env)
  (let ((result (env-loop env var)))
     (if result
         (set-binding-val! result val)
         (error "Unbound variable -- SET " var))))

(define (define-variable! var val env)
  (let ((result (scan (first-frame env) var)))
    (if (result)
        (set-binding-val! result val)
        (add-binding-to-frame! var val (first-frame env)))))

4.13

仕様を以下のように定める - 4.11 の実装をベースに行う - 渡された環境のみを操作する(外側の環境の変数は別の環境が依存している可能性があるので危険)

(define (unbind! var frame)
  (define (scan-to-unbind frame)
    (if (null? frame)
        (error "Unbound variable -- UNBOUND " var)
        (let ((binding (first-binding frame)))
           (if (eq? var (binding-var binding))
               (rest-bindings frame)
               (cons (binding (scan-to-unbind (rest-bindings frame))))))))
  (set! frame (scan-to-unbind frame)))

4.14

Louis がやったこ

(define primitive-procedures
  (list (list 'car car)
        (list 'cdr cdr)
        (list 'cons cons)
        (list 'null? null?)
        (list 'map map) ;mapを基本手続きとして追加
        ))

mapの呼ばれ方は

(map proc args...)

だが、 procもargsも引数とリストとして受けとってしまうのでうまくいかない。

4.15

設問どおり、 halts? の存在を仮定して、以下の処理を考える。

; (define (halts? p a)
;    (if ((p a)が停止する)
;        #t
;        #f
(define (run-forever) (run-forever))

(define (try p)
  (if (halts? p p)
      (run-forever)
      'halted))

ここで、

(try try)

を評価すると、

  1. (try try) が停止する場合 -> (halts try try) は 真 -> run-forever が実行されるため、(try try)は停止しない

  2. (try try) が停止する場合 -> (halts try try) は 偽 -> 'halted が返却されるため、 (try try)は停止する

よって、矛盾が生じるため、背理法で hatls の存在は否定される。