smalltalk-tng

view experiments/stream-fusion.scm @ 321:c4a0718c2d3c

find changesets by author, revision, files, or words in the commit message
Sketch of dependencies
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
date Sat Oct 08 15:36:03 2011 -0400 (7 months ago)
parents
children
line source
1 (define-struct stream (stepper0 state0))
2
3 (define (stream-stepper stream-or-list)
4 (if (or (null? stream-or-list)
5 (pair? stream-or-list))
6 list-stream-stepper
7 (stream-stepper0 stream-or-list)))
8
9 (define (stream-state stream-or-list)
10 (if (or (null? stream-or-list)
11 (pair? stream-or-list))
12 stream-or-list
13 (stream-state0 stream-or-list)))
14
15 (define (stream-maker stepper)
16 (lambda (state)
17 (make-stream stepper state)))
18
19 (define (list-stream-stepper l done skip yield)
20 (if (null? l)
21 (done)
22 (yield (car l) (cdr l))))
23
24 (define list->stream (stream-maker list-stream-stepper))
25
26 (define (stream->list stream)
27 (sfoldr cons '() stream))
28
29 (define (smap f stream)
30 (let ((stepper (stream-stepper stream)))
31 (make-stream (lambda (state done skip yield)
32 (stepper state
33 done
34 skip
35 (lambda (elt new-state) (yield (f elt) new-state))))
36 (stream-state stream))))
37
38 (define (sfilter pred stream)
39 (let ((stepper (stream-stepper stream)))
40 (make-stream (lambda (state done skip yield)
41 (stepper state
42 done
43 skip
44 (lambda (elt new-state) (if (pred elt)
45 (yield elt new-state)
46 (skip new-state)))))
47 (stream-state stream))))
48
49 (define (sfoldr kons knil stream)
50 (let ((stepper (stream-stepper stream)))
51 (let loop ((state (stream-state stream)))
52 (stepper state
53 (lambda () knil)
54 (lambda (new-state) (loop new-state))
55 (lambda (elt new-state) (kons elt (loop new-state)))))))
56
57 (define (sfoldl kons knil stream)
58 (let ((stepper (stream-stepper stream)))
59 (let loop ((knil knil)
60 (state (stream-state stream)))
61 (stepper state
62 (lambda () knil)
63 (lambda (new-state) (loop new-state))
64 (lambda (elt new-state) (loop (kons elt knil) new-state))))))
65
66 (define-struct szip-state (cell left right))
67
68 (define (szip left right)
69 (let ((left-stepper (stream-stepper left))
70 (right-stepper (stream-stepper right)))
71 (make-stream (lambda (state done skip yield)
72 (let ((cell (szip-state-cell state)))
73 (cond
74 ((null? cell)
75 (right-stepper
76 (szip-state-right state)
77 done
78 (lambda (new-right)
79 (skip (make-szip-state '() (szip-state-left state) new-right)))
80 (lambda (elt new-right)
81 (skip (make-szip-state (list elt) (szip-state-left state) new-right)))))
82 (else
83 (left-stepper
84 (szip-state-left state)
85 done
86 (lambda (new-left)
87 (skip (make-szip-state cell new-left (szip-state-right state))))
88 (lambda (elt new-left)
89 (yield (cons elt cell)
90 (make-szip-state '() new-left (szip-state-right state)))))))))
91 (make-szip-state '() (stream-state left) (stream-state right)))))
92
93 (define-struct sconcatmap-state (first-stepper first-state remaining-streams))
94
95 (define (sconcatmap f streams)
96 (let ((remaining-streams-stepper (stream-stepper streams)))
97 (make-stream (lambda (state done skip yield)
98 (let ((first-stepper (sconcatmap-state-first-stepper state)))
99 (if first-stepper
100 (first-stepper (sconcatmap-state-first-state state)
101 (lambda ()
102 (skip (make-sconcatmap-state
103 #f #f
104 (sconcatmap-state-remaining-streams state))))
105 (lambda (new-first-state)
106 (skip (make-sconcatmap-state
107 first-stepper new-first-state
108 (sconcatmap-state-remaining-streams state))))
109 (lambda (elt new-first-state)
110 (yield elt
111 (make-sconcatmap-state
112 first-stepper new-first-state
113 (sconcatmap-state-remaining-streams state)))))
114 (remaining-streams-stepper (sconcatmap-state-remaining-streams state)
115 done
116 (lambda (new-remaining-streams)
117 (skip (make-sconcatmap-state
118 #f #f
119 new-remaining-streams)))
120 (lambda (first new-remaining-streams)
121 (let ((first-stream (f first)))
122 (skip (make-sconcatmap-state
123 (stream-stepper first-stream)
124 (stream-state first-stream)
125 new-remaining-streams))))))))
126 (make-sconcatmap-state #f #f (stream-state streams)))))
127
128 (define (sconcatenate streams)
129 (sconcatmap (lambda (stream) stream) streams))