Scheme - 標準部品化力、オブジェクトおよび状態(ストリーム(ストリームは遅延リスト(ストリームの実装の働き、delayとforceの実装(stream-mapの実装))))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)

開発環境

• OS X Mavericks - Apple(OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の3(標準部品化力、オブジェクトおよび状態)、3.5(ストリーム)、3.5.1(ストリームは遅延リスト)、ストリームの実装の働き、delayとforceの実装、問題 3.50.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)

問題 3.50.

コード(BBEdit, Emacs)

stream.scm

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

;; メモ化無し
;; (define (delay exp)
;;   (lambda () exp))

;; メモ化あり
(define (delay exp)
  (memo-proc (lambda () exp)))

(define (force delayed-object)
  (delayed-object))

(define (cons-stream x y)
  (cons x (delay y)))

(define (stream-car stream) (car stream))

(define (stream-cdr stream) (force (cdr stream)))

(define (stream-ref s n)
  (if (= n 0)
      (stream-car s)
      (stream-ref (stream-cdr s)
                  (- n 1))))

(define the-empty-stream '())

(define stream-null? null?)

(define (stream-enumerate-interval low high)
  (if (> low high)
      the-empty-stream
      (cons-stream low
                   (stream-enumerate-interval (+ low 1) high))))

(define (stream-filter pred stream)
  (cond ((stream-null? stream) the-empty-stream)
        ((pred (stream-car stream))
         (cons-stream (stream-car stream)
                      (stream-filter pred
                                     (stream-cdr stream))))
        (else (stream-filter pred
                             (stream-cdr stream)))))

(define (stream-for-each proc s)
  (if (stream-null? s)
      'done
      (begin (proc (stream-car s))
             (stream-for-each proc (stream-cdr s)))))

(define (display-stream s)
  (stream-for-each print s))

(define (memo-proc proc)
  (let ((already-run? #f)
        (result #f))
    (lambda ()
      (if (not already-run?)
          (begin (set! result (proc))
                 (set! already-run? #t)
                 result)
          result))))

;; 問題 3.50
(define (stream-map proc . argstreams)
  (if (stream-null? (car argstreams))
      the-empty-stream
      (cons-stream
       (apply proc (map stream-car argstreams))
       (apply stream-map
              (cons proc (map stream-cdr argstreams))))))

sample50.scm

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

(load "./stream.scm")

(display-stream
 (stream-map +
             (stream-enumerate-interval 1 3)
             (cons-stream 40
                          (cons-stream 50
                                       (cons-stream 60
                                                    the-empty-stream)))
             (cons-stream 700
                          (cons-stream 800
                                       (cons-stream 900
                                                    the-empty-stream)))))

(display-stream
 (stream-map +
             (stream-enumerate-interval 1 3)
             (stream-enumerate-interval 4 6)))

入出力結果(Terminal(gosh), REPL(Read, Eval, Print, Loop))

$ ./sample50.scm
741
852
963
5
7
9
$