SICP streams have (cons-stream a b) == (cons a (delay b))
. I'm not sure if the authors show the actual delay
implementation, but in Scheme it is memoizing -- it creates a promise as a memory structure (object) which calculates the value and stores it on first access, and directly returns it on every subsequent access.
Thus a SICP stream is represented as a cons
pair whose car
field contains a ready-made value and the cdr
field contains the memoizing promise:
(define (head s) (car s))
(define (tail s) (force (cdr s)))
force
is defined so that it will recognize a promise that is already forced, and will just return the stored value in such a case.
So then, we have:
(define ones (cons 1 (delay ones)))
;; ones :=> <1 . {promise1 DELAYED (thunk ones)}>
;; -- pseudocode representation of a memory object
Let's start the integers from 10, so it's easier to follow the lengthy code listing below:
(define ints (cons 10 (delay (add-streams ints ones))))
;; ints :=> <10 . {promise2 DELAYED (thunk (add-streams ints ones))}>
;; -- pseudocode representation of a memory object
So the first tail
applied to ones
forces ones
's cdr
and thus changes the contents of the structure referred to by ones
into ones :=> <1 . {promise1 FORCED ones}>
(symbolically).
And now, it goes like this:
(head (tail (tail ints)))
= ;1 ; pseudocode .......
(letrec
([ones :=> <1 . {promise1 DELAYED (thunk ones)}> ]
[ints :=> <10 . {promise2 DELAYED (thunk (add-streams ints ones))}>]
[b (tail ints)]
[a (tail b)]) ; single assignment transformation
(head a))
= ;2
(letrec
([ones :=> <1 . {promise1 DELAYED (thunk ones)}> ]
[ints :=> <10 . {promise2 DELAYED (thunk (add-streams ints ones))}>]
[b (tail ints)]
[a (force (cdr b))]) ; progressive evaluation
(head a))
= ;3
(letrec
([ones :=> <1 . {promise1 DELAYED (thunk ones)}> ]
[ints :=> <10 . {promise2 DELAYED (thunk (add-streams ints ones))}>]
[b (force (cdr ints))]
[a (force (cdr b))])
(head a))
= ;4
(letrec
([ones :=> <1 . {promise1 DELAYED (thunk ones)}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b (add-streams ints ones)] ; forcing
[a (force (cdr b))])
(head a))
= ;5
(letrec
([ones :=> <1 . {promise1 DELAYED (thunk ones)}>]
[ints :=> <10 . {promise2 FORCED b}>]
[h1 (head ints)]
[h2 (head ones)]
[b (cons (+ h1 h2) (delay
(add-streams (tail ints) (tail ones))))]
[a (force (cdr b))])
(head a))
= ;6
(letrec
([ones :=> <1 . {promise1 DELAYED (thunk ones)}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b :=> <11 . {promise3 DELAYED (thunk
(add-streams (tail ints) (tail ones)))}>]
[a (force (cdr b))])
(head a))
= ;7
(letrec
([ones :=> <1 . {promise1 DELAYED (thunk ones)}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b :=> <11 . {promise3 FORCED a}>]
[a (add-streams (tail ints) (tail ones))])
(head a))
= ;8
(letrec
([ones :=> <1 . {promise1 DELAYED (thunk ones)}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b :=> <11 . {promise3 FORCED a}>]
[s1 (tail ints)]
[s2 (tail ones)]
[a (add-streams s1 s2)])
(head a))
= ;9
(letrec
([ones :=> <1 . {promise1 DELAYED (thunk ones)}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b :=> <11 . {promise3 FORCED a}>]
[s1 (force (cdr ints))]
[s2 (force (cdr ones))]
[a (add-streams s1 s2)])
(head a))
= ;10
(letrec
([ones :=> <1 . {promise1 DELAYED (thunk ones)}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b :=> <11 . {promise3 FORCED a}>]
[s1 b] ; (cdr ints) is already forced
[s2 (force (cdr ones))]
[a (add-streams s1 s2)])
(head a))
= ;11
(letrec
([ones :=> <1 . {promise1 DELAYED (thunk ones)}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b :=> <11 . {promise3 FORCED a}>]
[s2 (force (cdr ones))]
[a (add-streams b s2)])
(head a))
= ;12
(letrec
([ones :=> <1 . {promise1 FORCED s2}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b :=> <11 . {promise3 FORCED a}>]
[s2 ones]
[a (add-streams b s2)])
(head a))
continuing,
= ;13
(letrec
([ones :=> <1 . {promise1 FORCED ones}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b :=> <11 . {promise3 FORCED a}>]
[a (add-streams b ones)])
(head a))
= ;14
(letrec
([ones :=> <1 . {promise1 FORCED ones}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b :=> <11 . {promise3 FORCED a}>]
[a :=> <12 . {promise4 DELAYED (thunk
(add-streams (tail b) (tail ones)))}>])
(head a)) ; value of a is found
= ;15
(letrec
([ones :=> <1 . {promise1 FORCED ones}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b :=> <11 . {promise3 FORCED a}>]
[a :=> <12 . {promise4 DELAYED (thunk
(add-streams (tail b) (tail ones)))}>])
(car a)) ; head is car
= ;16
12
and hopefully this is clear enough to illustrate what is going on here.
In particular, the tail of ones
, once forced, becomes ones
itself, and stays so forced henceforth -- there are no further delay
s there afterwards.
The above of course follows the definition
(define (add-streams s1 s2)
(cond [(null-stream? s1) s2]
[(null-stream? s2) s1]
[else
(cons (+ (head s1) (head s2))
(delay
(add-streams (tail s1) (tail s2))))]))
As can be seen above, the memoizing promise implementation is only superficially different but in the end functionally equivalent to the tail-mutating implementation which can be seen in this answer by yours truly, though in a different setting.
A variation for this tail-mutating approach, one matching the SICP styled use case here, was given by Sylwester in the comments above:
(define-syntax cons-stream
(syntax-rules ()
((_ a d)
(letrec ([pair (cons a
(lambda ()
(set-cdr! pair d)
(cdr pair)))])
pair))))
under which, calling (head (tail (tail ints)))
results in ones ; ==> #0=(1 . #0#)
and ints ; ==> (10 11 12 . #<procedure>)
.
ones ; ==> #0=(1 . #0#)
literally means ones = <1 . ones>
, which is practically the same as <1 . {promise1 FORCED ones}>
that can be seen in the derivations above.
Equivalently, we can keep the cons-stream
as simply delaying, and have stream-cdr
do the memoizing:
(define-syntax cons-stream
(syntax-rules ()
((_ h t) (cons h (lambda () t)))))
(define (stream-cdr s)
(if (and (not (pair? (cdr s)))
(not (null? (cdr s))))
(set-cdr! s ((cdr s))))
(cdr s))
A side observation, step 15 could also be followed by
= ;15
(letrec
([ones :=> <1 . {promise1 FORCED ones}>]
[ints :=> <10 . {promise2 FORCED b}>]
[b :=> <11 . {promise3 FORCED a}>]
[a :=> <12 . {promise4 DELAYED (thunk
(add-streams (tail b) (tail ones)))}>])
(car a)) ; head is car
=
(letrec
([ones :=> <1 . {promise1 FORCED ones}>]
[a :=> <12 . {promise4 DELAYED (thunk
(add-streams a ones))}>])
(car a))
=
(letrec
[a :=> <12 . {promise4 DELAYED (thunk
(map-stream 1+ a))}>])
(car a))
which suggests an alternative definition for ints
,
(define (ints-from a)
(letrec ([s (cons-stream a (map-stream 1+ s))])
s))
or
(define (ints-from a)
(let loop ([a a])
(cons-stream a (loop (+ a 1)))))
or even just
(define (ints-from a)
(cons-stream a
(ints-from (+ a 1))))