プログラミング再入門

プログラミングをもう一度ちゃんと勉強する読書ノート

SICP 4.2.3 Streams as Lazy Lists

ノート

遅延リストとしてのストリーム。

3.5.1節で導入したストリームはdelay、cons-streamと言う構文を使ってストリームを作ったため、ストリームには普通のリスト用の手続きは使えず、ストリーム用の手続きを使う必要があった。
遅延評価のシステムではこれらを区別する必要は無い。
プリミティブからcons、car、cdrを除いて、(null?とnullは足して)実行してみる。

> (driver-loop)

;;; L-Eval input:
(define (cons x y)
  (lambda (m) (m x y)))
(define (car z)
  (z (lambda (p q) p)))
(define (cdr z)
  (z (lambda (p q) q)))
;;; L-Eval value:
ok
;;; L-Eval input:
;;; L-Eval value:
ok
;;; L-Eval input:
;;; L-Eval value:
ok
;;; L-Eval input:
(define (list-ref items n)
  (if (= n 0)
      (car items)
      (list-ref (cdr items) (- n 1))))
(define (map proc items)
  (if (null? items)
      '()
      (cons (proc (car items))
            (map proc (cdr items)))))
(define (scale-list items factor)
  (map (lambda (x) (* x factor))
       items))
(define (add-lists list1 list2)
  (cond ((null? list1) list2)
        ((null? list2) list1)
        (else (cons (+ (car list1) (car list2))
                    (add-lists (cdr list1) (cdr list2))))))
(define ones (cons 1 ones))
(define integers (cons 1 (add-lists ones integers)))
;;; L-Eval value:
ok
;;; L-Eval input:
;;; L-Eval value:
ok
;;; L-Eval input:
;;; L-Eval value:
ok
;;; L-Eval input:
;;; L-Eval value:
ok
;;; L-Eval input:
;;; L-Eval value:
ok
;;; L-Eval input:
;;; L-Eval value:
ok
;;; L-Eval input:
(list-ref integers 17)
;;; L-Eval value:
18
;;; L-Eval input:
(define (integral integrand initial-value dt)
  (define int
    (cons initial-value
          (add-lists (scale-list integrand dt)
                    int)))
  int)
(define (solve f y0 dt)
  (define y (integral dy y0 dt))
  (define dy (map f y))
  y)
;;; L-Eval value:
ok
;;; L-Eval input:
;;; L-Eval value:
ok
;;; L-Eval input:
(list-ref (solve (lambda (x) x) 1 0.001) 1000)
;;; L-Eval value:
2.716923932235896
;;; L-Eval input:
.

(list-ref integers 17)の挙動を正確に把握するのはかなり難しい。
list-refはnが0になるまで再帰的に呼び出され、その結果は(car (cdr (cdr ... (cdr integers) ...)))となる。
ここで、(car integers)は1
(car (cdr integers)は(add-list ones integers)で、これは(+ (car ones) (car integers))
(car (cdr (cdr integers)は(car (cdr (add-lists ones inegers)))で、これは(car (add-lists (cdr ones) (cdr integers)))なので(+ (car (cdr ones)) (car (cdr integers)))
と言った具合なので、list-refの結果を評価するには最後の足し算のオペランド部分でonesとintegersのリストを一旦先頭に向かって辿り、足し算をしながらまた戻って来る。

Exercise 4.32

脚注41にある様に、3章のストリームよりも更にlazyなのはcarの部分も遅延している事であり、その利点はtreeの様にcar以下にも無限に延びるtreeが構築出来る事。

treeが例だからこれで良しとするか、実際に動くtreeを構築するか迷う所。

Exercise 4.33

エラーを再現する。

> (driver-loop)

;;; L-Eval input:
(define (cons x y)
  (lambda (m) (m x y)))
(define (car z)
  (z (lambda (p q) p)))
(define (cdr z)
  (z (lambda (p q) q)))
;;; L-Eval value:
ok
;;; L-Eval input:
;;; L-Eval value:
ok
;;; L-Eval input:
;;; L-Eval value:
ok
;;; L-Eval input:
(car '(a b c))
. . Unknown procedure type -- APPLY-PROC (a b c)
> 
(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((quoted? exp) (eval-quotation exp env))
;…以下省略

(define (eval-quotation exp env)
  (let ((item (cadr exp)))
    (if (pair? item)
        (eval (list 'cons
                    (list 'quote (car item))
                    (list 'quote (cdr item)))
              env)
        item)))

cons、car、cdrをプリミティブではない手続きにしているのに、評価器がこれらの手続きに依存する事に非常に違和感を覚えるが、仕方ないのか?最低でもconsだけは遅延されるプリミティブとして最初から評価器に組み込まれていると考えれば良いのか。
動作確認

;;; L-Eval input:
'(a b c)
;;; L-Eval value:
(compound-procedure (m) ((m x y)) <procedure-env>)
;;; L-Eval input:
(car '(a b c))
;;; L-Eval value:
a
;;; L-Eval input:
(cdr '(a b c))
;;; L-Eval value:
(compound-procedure (m) ((m x y)) <procedure-env>)
;;; L-Eval input:
(car (cdr '(a b c)))
;;; L-Eval value:
b
;;; L-Eval input:
.

どうも引用符の扱いがややこしい。どうやら入力やら表示の段階でシステムが色々と変換してしまうので混乱している。'(a b c)と入力しても内部では(quote (a b c))と書き替わっている模様。でtext-of-quotationでexpを表示しても'(a b c)と表示される。入力に(quote (a b c))とタイプしてもtext-of-quotationでexpを表示すると'(a b c)と表示される。

Exercise 4.34

前の実行例にもあった様にconsペアはuser-printで少し整形されて手続きとして表示される。

;;; L-Eval input:
(cons 1 2)
;;; L-Eval value:
(compound-procedure (m) ((m x y)) <procedure-env>)
;;; L-Eval input:

つまり、consペアの場合はuser-printでcarとcdrのactual-valueを表示すると言う事。
その為には普通の手続きとconsペアの手続きの区別がつかなければならない。

ネットで調べた回答には、consに対してはlambdaではなくlist-lambdaと言う構文を使うと言うもの。これはprocedureの代わりにlist-procedureと言うタグを作る。compound-procedure?がどちらも手続きだと認識しさえすれば評価に関しての影響は少ない。表示させたいが為に新しい構文を導入するのはどうかと思う一方、consだけは遅延されるプリミティブとして扱うと言う事であればこれも有りかもしれない。
更にどうぜconsだけは遅延されるプリミティブとして特別扱いするのであれば、ネットでもう一つ見つけた回答の「表示させる時に手続きの本体が(lambda (m) (m x y))だったらconsとみなす」と言う回答もかなり強引だけどありだと思う。

全く同じ回答も芸がないので、the-global-environmentからconsを探して、それと一致した手続きをconsとみなす事にする。

apply-procを呼び出す時に評価から戻って来たconsは'procedureで始まるオブジェクトだがapply-procが期待しているのは対象Lispの式なのでこれをもう一度lambda式に戻してあげる必要が有る。そうしないとprocedureと言う手続きを呼び出そうとする。lambdaで始まるリストはevalでprocedureに変換されて、もういちどちゃんと評価される。

(eval '(define **max-print-depth** 5) the-global-environment)

(define (user-print object)
  (if (compound-procedure? object)
      (display (if (cons? object)
                   (cons->list object (lookup-variable-value '**max-print-depth** the-global-environment))
                   (list 'compound-procedure
                         (procedure-parameters object)
                         (procedure-body object)
                         '<procedure-env>)))
      (display object)))

(eval '(define (cons x y)
         (lambda (m) (m x y))) the-global-environment)
(eval '(define (car z)
         (z (lambda (p q) p))) the-global-environment)
(eval '(define (cdr z)
         (z (lambda (p q) q))) the-global-environment)

(define (cons? exp)
  (if (compound-procedure? exp)
      (let ((cons-def (car (procedure-body (lookup-variable-value 'cons the-global-environment)))))
        (and (equal? (procedure-parameters exp)
                     (procedure-parameters cons-def))
             (equal? (car (procedure-body exp))
                     (procedure-body cons-def))))
      #f))

(define (cons? exp)
  (if (compound-procedure? exp)
      (let ((cons-def (car (procedure-body (lookup-variable-value 'cons the-global-environment)))))
        (and (equal? (procedure-parameters exp)
                     (procedure-parameters cons-def))
             (equal? (car (procedure-body exp))
                     (procedure-body cons-def))))
      #f))
  
(define (cons->list object count)
  (define (evaluate proc operand)
    (force-it 
     (apply-proc (actual-value proc the-global-environment)
                 (list (make-lambda (procedure-parameters operand)
                                    (procedure-body operand)))
                 (procedure-environment operand))))
  (define (expand-cons x n)
    (if (cons? x)
        (if (eq? n 0)
            '(...)
            (cons->list x n))
        x))
  (cons (expand-cons (evaluate 'car object) (- count 1))
        (expand-cons (evaluate 'cdr object) (- count 1))))

表示する深さもthe-global-environmentに定義する事にした。
動作確認

;;; L-Eval input:
'(1 2)
;;; L-Eval value:
(1 2)
;;; L-Eval input:
(cons 1 2)
;;; L-Eval value:
(1 . 2)
;;; L-Eval input:
(define ones (cons 1 ones))
;;; L-Eval value:
ok
;;; L-Eval input:
ones
;;; L-Eval value:
(1 1 1 1 1 ...)
;;; L-Eval input:
(define (add-lists list1 list2)
  (cond ((null? list1) list2)
        ((null? list2) list1)
        (else (cons (+ (car list1) (car list2))
                    (add-lists (cdr list1) (cdr list2))))))
;;; L-Eval value:
ok
;;; L-Eval input:
(define integers (cons 1 (add-lists ones integers)))
;;; L-Eval value:
ok
;;; L-Eval input:
integers
;;; L-Eval value:
(1 2 3 4 5 ...)
;;; L-Eval input:
**max-print-depth**
;;; L-Eval value:
5
;;; L-Eval input:
(define **max-print-depth** 10)
;;; L-Eval value:
ok
;;; L-Eval input:
**max-print-depth**
;;; L-Eval value:
10
;;; L-Eval input:
integers
;;; L-Eval value:
(1 2 3 4 5 6 7 8 9 10 ...)
;;; L-Eval input:
.

こことSICP Exercise 4.34 | Weiqun Zhang's Blog
ここMentioned In Dispatches: SICP Section 4.2 Variations on a Scheme -- Lazy Evaluation
を参考にさせて戴きました。