/
streambasic.scm
executable file
·178 lines (150 loc) · 4.33 KB
/
streambasic.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
; Streambasic: This file has the basic routines for working with streams,
; and also defines delay/force as special forms if they are needed.
; Be sure to uncomment the desired definition of (delay) below.
; Convenience function to print output followed by a newline
(define (display-line ln)
(display ln)
(newline)
)
; Many Scheme implementations have (force) and (delay)
; already defined, although they may or may not use memoization.
; ** NOTE **
; If any version of delay in this file is used, force should be defined explicitly,
; along with cons-stream and other stream procedures in this file.
; Memoized form of delay (cf. text's *memo-proc*)
(define-syntax delay
(syntax-rules ()
((_ x) (let ((already-run? false)
(result false)
)
(lambda ()
(if (not already-run?)
(begin
(set! result x)
(set! already-run? true)
result
)
result
)
)
)
)
)
)
; Alternate versions of delay for testing
; Delay will not evaluate arguments, but is not memoized
;(define-syntax delay
; (syntax-rules ()
; ((_ x) (lambda () x))
; )
; )
; Delay is just a lambda expression [not properly delaying]
;(define (delay x)
; (lambda () x)
; )
; Forcing a delay, for all versions
(define (force delayed-object) (delayed-object))
; Special form for cons-stream
; To prevent arguments from being evaluated
(define-syntax cons-stream
(syntax-rules ()
((_ a b) (cons a (delay b))
)
)
)
; Basic Stream operations
(define (stream-car stream) (car stream))
(define (stream-cdr stream) (force (cdr stream)))
(define the-empty-stream '())
(define stream-null? null?)
(define (stream-ref s n)
(if (= n 0)
(stream-car s)
(stream-ref (stream-cdr s) (- n 1))
)
)
(define (stream-map proc s)
(if (stream-null? s)
the-empty-stream
(cons-stream (proc (stream-car s))
(stream-map proc (stream-cdr s))
)
)
)
(define (stream-for-each proc s)
(if (stream-null? s)
'done
(begin
(proc (stream-car s))
(stream-for-each proc (stream-cdr s))
)
)
)
; Additional stream functions
(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)))
)
)
; Compact version, displays with spaces only
(define (display-stream-compact s)
(stream-for-each (lambda (s) (display s) (display " ")) s)
)
; Default version, each element on one line
(define (display-stream s)
(stream-for-each display-line s)
)
; This produces a stream applying a predicate to both streams.
; Appends a value of 'false' if the streams differ in length,
; or 'true' if they are the same length (including zero-length).
(define (stream-compare pred s1 s2)
(cond ((stream-null? s1)
(if (stream-null? s2)
(cons-stream true the-empty-stream)
(cons-stream false the-empty-stream)
)
)
((stream-null? s2) (cons-stream false the-empty-stream)) ; Already checked if s1 is done.
(else (cons-stream (pred (stream-car s1) (stream-car s2))
(stream-compare pred (stream-cdr s1) (stream-cdr s2))
)
)
)
)
; Tests if all elements of a stream are true; exits on first false element
(define (stream-and s)
(if (stream-null? s)
true
(if (stream-car s)
(stream-and (stream-cdr s))
false
)
)
)
; Shortcut for testing that stream-compare passed for every element
(define (stream-test pred s1 s2)
(stream-and (stream-compare pred s1 s2))
)
(define (list-to-stream li)
(if (null? li)
the-empty-stream
(cons-stream (car li) (list-to-stream (cdr li)))
)
)