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
|
(define-module (srfi srfi-41 util)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-41)
#:use-module (util) ; let*, find-min
#:export (stream-car+cdr interleave-streams with-streams))
(define (stream-car+cdr stream)
(values (stream-car stream)
(stream-cdr stream)))
;; Merges a number of totally ordered streams into a single
;; totally ordered stream.
;; ((≺, stream)) → (≺, stream)
(define (interleave-streams < streams)
;; Drop all empty streams
(let ((streams (remove stream-null? streams)))
;; If all streams where empty, end the output stream
(if (null? streams)
stream-null
(let* ((min other (find-extreme streams < stream-car))
(m ms (stream-car+cdr min)))
(stream-cons m (interleave-streams < (cons ms other)))))))
(define-public (stream-insert < item s)
(interleave-streams < (list (stream item) s)))
;; Requires that stream is a total order in regards to what we filter
;; on. From there it knows that once it has found the first element
;; that satisfies our predicate all remaining elements satisfying pred
;; will be in direct succession.
;; Does have some drawbacks, concider an event between 2020-01-01 and 2020-12-31.
;; The collection is sorted on start time, and we want all events overlapping the
;; interval 2020-02-01 to 2020-02-29. We would get the long event, but then probably
;; stop because all regular small events in january.
(define-public (filter-sorted-stream pred stream)
(stream-take-while
pred (stream-drop-while
(negate pred) stream)))
;; Simmilar to the regular @code{filter-sorted-stream}, but once an
;; element satisfies @code{keep-remaning?} then the remaining tail
;; of the stream is all assumed to be good.
(define-public (filter-sorted-stream* pred? keep-remaining? stream)
(cond [(stream-null? stream) stream-null]
[(keep-remaining? (stream-car stream)) stream]
[(pred? (stream-car stream))
(stream-cons (stream-car stream)
(filter-sorted-stream*
pred? keep-remaining?
(stream-cdr stream)))]
[else (filter-sorted-stream* pred? keep-remaining?
(stream-cdr stream))]))
;; returns all object in stream from the first object satisfying
;; start-pred, until the last object which sattisfies end-pred.
(define-public (get-stream-interval start-pred end-pred stream)
(stream-take-while
end-pred (stream-drop-while
(negate start-pred)
stream)))
;; Finds the first element in stream satisfying pred.
;; Returns #f if nothing was found
(define-public (stream-find pred stream)
(cond ((stream-null? stream) #f)
((pred (stream-car stream)) (stream-car stream))
(else (stream-find pred (stream-cdr stream)))))
(define-public (stream-remove pred stream)
(stream-filter (negate pred) stream))
(define-public (stream->values stream)
(apply values (stream->list stream)))
;; Returns two values. A stream of all the elements in stream
;; which satisfiy @var{pred}, and a stream of those elements
;; that don't. @var{pred} is called once per value in the
;; input stream.
(define-public (stream-partition pred stream)
(let ((strm (stream-zip (stream-map pred stream)
stream)))
(values
(stream-map cadr (stream-filter car strm))
(stream-map cadr (stream-remove car strm)))))
(define-public (stream-split idx stream)
(stream-cons (stream-take idx stream)
(stream-drop idx stream)))
(define-stream (stream-paginate% stream page-size)
(stream-match (stream-split page-size stream)
((page . rest)
(if (stream-null? page)
stream-null
(stream-cons
page
(stream-paginate rest page-size))))))
(define*-public (stream-paginate stream optional: (page-size 10))
(stream-paginate% stream page-size))
;; Evaluates @var{body} in a context where most list fundamentals are
;; replaced by stream alternatives.
;; commented defifinitions are items which could be included, but for
;; one reason or another isn't.
;; TODO Possibly give access to list-primitives under a list- prefix.
;; TODO since this macro is inhygienic it requires that (srfi srfi-41)
;; is included at the point of use.
(define-macro (with-streams . body)
`(let-syntax
((cons (identifier-syntax stream-cons))
(null? (identifier-syntax stream-null?))
(pair? (identifier-syntax stream-pair?))
(car (identifier-syntax stream-car))
(cdr (identifier-syntax stream-cdr))
;; stream-lambda
;; define-stream
(append (identifier-syntax stream-append))
(concat (identifier-syntax stream-concat))
;; (const stream-constant)
(drop (identifier-syntax stream-drop))
(drop-while (identifier-syntax stream-drop-while))
(filter (identifier-syntax stream-filter))
(fold (identifier-syntax stream-fold))
(for-each (identifier-syntax stream-for-each))
(length (identifier-syntax stream-length))
;; stream-let
(map (identifier-syntax stream-map))
;; stream-match
;; stream-range
;; stream-ref
(reverse (identifier-syntax stream-reverse))
;; stream-scan
(take (identifier-syntax stream-take))
(take-while (identifier-syntax stream-take-while))
(zip (identifier-syntax stream-zip)))
,@body))
|
