[plt-scheme] Question about delayed evaluation

From: Jens Axel Søgaard (jensaxel at soegaard.net)
Date: Tue Mar 4 12:08:35 EST 2003

Noel Welsh wrote:
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme
> The short answer is to write a macro.

(require (lib "defmacro.ss"))

; cons-stream : obj stream ->  stream
; (special form) constructs a stream whose first element i obj and whose
tail is stream
(define-macro cons-stream
  (lambda (car cdr)
    `(cons ,car (delay ,cdr))))

More SICP'isms is defined below.

My personal favorite is the mutual recursive definition
of prime? and primes.

PS: This was meant for my eyes only. I think it was one of the
    first things I tried since discovering DrScheme.


(require (lib "defmacro.ss"))

;;  Kilde: SICP side 316

;;; STREAM Data Definition

; A STREAM is either
;    the-empty-stream
; or
;    (cons-stream car cdr)   ; where cdr is a stream

;; Utilities

(define ... 'not-implemented)

(define (square x)
  (* x x))

; the empty stream
(define the-empty-stream '())

; empty-stream? object -> boolean
(define empty-stream? null?)
(define stream-null? empty-stream?)
(define empty? empty-stream?)


; cons-stream : obj stream ->  stream
; (special form) constructs a stream whose first element i obj and whose
tail is stream
(define-macro cons-stream
  (lambda (car cdr)
    `(cons ,car (delay ,cdr))))


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

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


; Selector

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

(define (stream->list s n)
  (if (= n 0)
      (if (not (empty? s))
          (cons (stream-car s)
                (stream->list (stream-cdr s) (- n 1)))

; Higher order

(define (stream-map proc . streams)
  (if (stream-null? (car streams))
       (apply proc (map stream-car streams))
       (apply stream-map
              (cons proc (map stream-cdr streams))))))

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

(define (stream-filter predicate stream)
    [(empty? stream)                 the-empty-stream]
    [(predicate (stream-car stream)) (cons-stream (stream-car stream)
                                                  (stream-filter predicate
(stream-cdr stream)))]
    [else                            (stream-filter predicate (stream-cdr

; combining

(define (merge s1 s2)
    [(empty? s1) s2]
    [(empty? s2) s1]
    [else (let ([s1car (stream-car s1)]
                [s2car (stream-car s2)])
              [(< s1car s2car) (cons-stream s1car (merge (stream-cdr s1)
              [else            (cons-stream s2car (merge (stream-cdr s2)

;;; Aritmetical

(define (add-streams s1 s2)
  (stream-map + s1 s2))

(define (mul-streams s1 s2)
  (stream-map * s1 s2))

(define (scale-stream k s)
  (stream-map (lambda (x) (* k x))

(define (constant-stream c)
  (scale-stream c ones))

(define (partial-sums s)
  (cons-stream (stream-car s)
               (add-streams (constant-stream (stream-car s))
                            (partial-sums (stream-cdr s)))))

; Output

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

(define (display-line x)
  (display x))

;;; Numbers

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

(define (integers-starting-from n)
  (cons-stream n (integers-starting-from (+ n 1))))

(define (even? x)
  (= (remainder x 2) 0))

;;; Primes

; Sieve if Eratosthenes
(define (sieve stream)
  (cons-stream (stream-car stream)
               (sieve (stream-filter (lambda (x)
                                       (not (= (remainder x (stream-car
stream)) 0)))
                                     (stream-cdr stream)))))

(define primes (sieve (integers-starting-from 2)))
(define (prime? n)
  (let loop ([s primes])
      [(< n (stream-car s)) #f]
      [(= n (stream-car s)) #t]
      [else (loop (stream-cdr s))])))

; fractions

; returns the sequence of digits of num/den expressed in radix
(define (expand num den radix)
  (cons-stream (quotient (* num radix) den)
               (expand (remainder (* num radix) den) den radix)))

; Power Series

; remember to cons an constant term after integration
(define (integrate-series s)
  (stream-map * s inverses))

(define exp-series (cons-stream 1 (integrate-series exp-series)))
(define cos-series (cons-stream 1 (scale-stream -1 (integrate-series
(define sin-series (cons-stream 0 (integrate-series sin-series)))

(define (mul-series s1 s2)
  (cons-stream (* (stream-car s1) (stream-car s2))
               (add-streams (scale-stream (stream-car s1) s2)
                            (scale-stream (stream-car s2) s1)
                            (mul-series (stream-cdr s1) (stream-cdr s2)))))

; Limits

(define (average x y)
  (/ (+ x y) 2))

(define (sqrt-improve guess x)
  (average guess (/ x guess)))

(define (sqrt-stream x)
  (letrec ([guesses (cons-stream 1.0
                                 (stream-map (lambda (guess)
                                               (sqrt-improve guess x))

(define (pi-summands n)
  (cons-stream (/ 1.0 n)
               (stream-map - (pi-summands (+ n 2)))))

(define pi-stream (scale-stream 4 (partial-sums (pi-summands 1))))

; Euler accelerator

(define (euler-transform s)
  (let ([s0 (stream-ref s 0)]
        [s1 (stream-ref s 1)]
        [s2 (stream-ref s 2)])
    (cons-stream (- s2 (/ (square (- s2 s1))
                          (+ s0 (* -2 s1) s2)))
                 (euler-transform (stream-cdr s)))))

(define (make-tableau transform s)
  (cons-stream s
               (make-tableau transform
                             (transform s))))

(define (accelerated-sequence transform s)
  (stream-map stream-car
              (make-tableau transform s)))

; Sequences

(define ones (cons-stream 1 ones))
(define integers (integers-starting-from 1))
(define integers2 (cons-stream 1 (add-streams ones integers2)))
(define inverses (stream-map (lambda (x) (/ 1 x)) integers))

(define fibonacci (cons-stream 0
                               (cons-stream 1
                                            (add-streams fibonacci
(define factorials (cons-stream 1
                                (mul-streams integers factorials)))


(define interval-1000-1100 (stream-interval 1000 1100))
(define i interval-1000-1100)
(define true-predicate (lambda (x) #t))
;(display-stream i)
(define idiot (add-streams (mul-streams cos-series cos-series) (mul-streams
sin-series sin-series)))
;(display (stream->list (sqrt-stream 2) 50))
;(time (stream-ref pi-stream 20000))
;(display (stream->list (euler-transform pi-stream) 100))
(display (stream->list (accelerated-sequence euler-transform pi-stream)

Jens Axel Søgaard

Posted on the users mailing list.