Changeset 12653 in project


Ignore:
Timestamp:
11/29/08 18:41:20 (11 years ago)
Author:
azul
Message:

Including code of the egg, eventually will generate the egg from the wiki page.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • wiki/stream-ext

    r8534 r12653  
    1010This egg is made by [[http://azul.freaks-unidos.net/|Alejandro Forero Cuervo]] <azul@freaks-unidos.net>.
    1111
     12<enscript highlight=scheme filename='stream-ext'>
     13;; $Id: stream-ext.scm 5600 2006-05-19 20:01:00Z azul $
     14;;
     15;; This file is in the public domain and may be reproduced or copied without
     16;; permission from its author.  Citation of the source is appreciated.
     17;;
     18;; Alejandro Forero Cuervo <azul@freaks-unidos.net>
     19;;
     20;; This file implements an egg for Chicken Scheme that contains useful
     21;; extensions to work with streams as defined in srfi-40.
     22;;
     23;; Documentation is available in HTML format.
     24;;
     25;; Newer versions might be available at:
     26;;
     27;;    http://chicken.wiki.br/stream-ext
     28</enscript>
     29
    1230== Requires
    1331
    1432* [[srfi-40]]
    1533* [[format-modular]]
     34
     35<enscript highlight=scheme filename='stream-ext'>
     36(require-extension srfi-40 srfi-1 format-modular)
     37</enscript>
    1638
    1739== License
     
    3557
    3658The name stands for "eXchanged CONS."
     59
     60<enscript highlight=scheme filename='stream-ext'>
     61(define (stream-xcons a b) (stream-cons b a))
     62</enscript>
    3763</procedure>
    3864
     
    5379</examples>
    5480
     81<enscript highlight=scheme filename='stream-ext'>
     82(define (stream-cons* . elts)
     83  (stream-delay
     84   (if (null? (cdr elts))
     85     (car elts)
     86     (stream-cons (car elts) (apply stream-cons* (cdr elts))))))
     87</enscript>
    5588</procedure>
    5689
     
    67100=> <stream (c c c c)></enscript>
    68101
     102<enscript highlight=scheme filename='stream-ext'>
     103(define (make-stream n . rest)
     104  (let-optionals rest ((obj #f) (tail stream-null))
     105    (stream-tabulate n (constantly obj) tail)))
     106</enscript>
     107
    69108=== stream-tabulate
    70109
     
    77116<enscript highlight=scheme>(stream-tabulate 4 identity)
    78117=> #<stream (0 1 2 3)></enscript>
     118
     119<enscript highlight=scheme filename='stream-ext'>
     120(define (stream-tabulate n init-proc . rest)
     121  (assert (number? n))
     122  (assert (not (negative? n)))
     123  (let-optionals rest ((tail stream-null))
     124    (let loop ((i 0))
     125      (stream-delay
     126        (if (equal? i n)
     127          tail
     128          (stream-cons (init-proc i) (loop (+ i 1))))))))
     129</enscript>
    79130
    80131=== stream-iota
     
    95146=> #<stream (0 -0.1 -0.2 -0.3 -0.4)></enscript>
    96147
     148<enscript highlight=scheme filename='stream-ext'>
     149(define (stream-iota count . args)
     150  (let loop ((i count)
     151             (start (if (null? args) 0 (car args)))
     152             (step (if (or (null? args) (null? (cdr args))) 1 (cadr args))))
     153    (stream-delay
     154      (if (zero? i)
     155        stream-null
     156        (stream-cons start (loop (- i 1) (+ start step) step))))))
     157</enscript>
     158
    97159=== stream-format
    98160
     
    101163Does the same as {{(format #f fmt ...)}},
    102164but returns the result as a stream of characters rather than a string.
     165
     166<enscript highlight=scheme filename='stream-ext'>
     167(define (stream-format fmt . rest)
     168  (string->stream (apply format #f fmt rest)))
     169</enscript>
    103170
    104171=== stream-lines
     
    114181=> #<stream (#<stream (#\h #\e #\y)> #<stream (#\y #\o #\u)>)></enscript>
    115182
     183<enscript highlight=scheme filename='stream-ext'>
     184(define stream-lines (cut stream-split <> (cut equal? <> #\newline)))
     185</enscript>
     186
     187=== stream-unlines
     188
     189TODO: Document
     190
     191<enscript highlight=scheme filename='stream-ext'>
     192(define (stream-unlines lines)
     193  (stream-concatenate (stream-intersperse lines (stream #\newline))))
     194</enscript>
     195
     196=== make-infinite-stream
     197
     198TODO: Document
     199
     200<enscript highlight=scheme filename='stream-ext'>
     201(define (make-infinite-stream proc start)
     202  (stream-delay
     203    (let ((next (proc start)))
     204      (stream-cons next (make-infinite-stream proc next)))))
     205</enscript>
     206
    116207== Conversion
    117208
     
    122213Returns a list with the elements in stream {{str}}.
    123214It is an error to pass an infinite stream.
     215
     216<enscript highlight=scheme filename='stream-ext'>
     217(define (stream->list str)
     218  (if (stream-null? str)
     219    '()
     220    (cons (stream-car str) (stream->list (stream-cdr str)))))
     221</enscript>
    124222
    125223=== list->stream
     
    130228The list might be circular (infinite), in which case the resulting
    131229stream will be infinite as well.
     230
     231<enscript highlight=scheme filename='stream-ext'>
     232(define (list->stream list)
     233  (stream-delay
     234    (if (null? list)
     235      stream-null
     236      (stream-cons (car list) (list->stream (cdr list))))))
     237</enscript>
    132238
    133239=== stream->string
     
    142248This function is the inverse of {{string->stream}}.
    143249
     250<enscript highlight=scheme filename='stream-ext'>
     251(define stream->string (compose list->string stream->list))
     252</enscript>
     253
    144254=== string->stream
    145255
    146  [procedure] (string->stream str)
     256 [procedure] (string->stream str [tail])
    147257
    148258Returns a finite stream with the characters
    149 in the string {{str}}.
    150 
    151 This function is the inverse of {{stream->string}}.
     259in the string {{str}}.  {{tail}}, which defaults to
     260{{stream-null}}, is appended at the end.
     261
     262With {{tail}} set to {{stream-null}}, this function is the inverse of {{stream->string}}.
     263
     264<enscript highlight=scheme filename='stream-ext'>
     265(define (string->stream str . rest)
     266  (let-optionals rest ((tail stream-null))
     267    (let loop ((i 0))
     268      (stream-delay
     269       (if (equal? i (string-length str))
     270           tail
     271           (stream-cons (string-ref str i) (loop (+ i 1))))))))
     272</enscript>
    152273
    153274=== number->stream
     
    157278...
    158279
     280<enscript highlight=scheme filename='stream-ext'>
     281(define number->stream (compose string->stream number->string))
     282</enscript>
     283
    159284=== stream->number
    160285
     
    162287
    163288...
     289
     290<enscript highlight=scheme filename='stream-ext'>
     291(define stream->number (compose string->number stream->string))
     292</enscript>
     293
     294=== stream->vector
     295
     296 [procedure] (stream->vector str)
     297
     298...
     299
     300<enscript highlight=scheme filename='stream-ext'>
     301(define stream->vector (compose list->vector stream->list))
     302</enscript>
     303
     304=== vector->stream
     305
     306 [procedure] (vector->stream str)
     307
     308...
     309
     310<enscript highlight=scheme filename='stream-ext'>
     311(define vector->stream (compose list->stream vector->list))
     312</enscript>
     313
     314=== stream->symbol
     315
     316 [procedure] (stream->symbol str)
     317
     318...
     319
     320<enscript highlight=scheme filename='stream-ext'>
     321(define stream->symbol (compose string->symbol stream->string))
     322</enscript>
     323
     324=== symbol->stream
     325
     326 [procedure] (symbol->stream str)
     327
     328...
     329
     330<enscript highlight=scheme filename='stream-ext'>
     331(define symbol->stream (compose string->stream symbol->string))
     332</enscript>
    164333
    165334=== port->stream
     
    177346{{read-line}} can also be specified.
    178347
    179 TODO: Documment close-at-eof.
     348{{close-at-eof}}, which defaults to {{close-input-port}}, will be
     349called as soon as an end of file object is read from the port.
     350A common idiom is to use:
     351
     352 (port->stream (open-input-file path))
     353
     354This will case the file to be closed as soon as the entire input is
     355consumed.  However, the caller must be careful to actually read the entire
     356stream before discarding it or file descriptors will be leaked.
     357
     358<enscript highlight=scheme filename='stream-ext'>
     359(define (port->stream . rest)
     360  (let-optionals rest ((in (current-input-port)) (reader read-char) (close-at-eof close-input-port))
     361    (stream-delay
     362      (let ((element (reader in)))
     363        (cond
     364          ((eof-object? element) (when close-at-eof (close-at-eof in)) stream-null)
     365          (else (stream-cons element (port->stream in reader close-at-eof))))))))
     366</enscript>
    180367
    181368=== iterator->stream
     
    200387    (lambda (collect stop)
    201388      (for-each collect alist))))</enscript>
     389
     390<enscript highlight=scheme filename='stream-ext'>
     391(define (iterator->stream proc)
     392  (stream-delay
     393    (call-with-current-continuation
     394      (lambda (return)
     395        (proc
     396          (lambda (obj)
     397            (call-with-current-continuation
     398              (lambda (next)
     399                (return
     400                  (stream-cons obj
     401                    (stream-delay
     402                      (call-with-current-continuation
     403                        (lambda (new)
     404                          (set! return new)
     405                          (next #t)))))))))
     406          (lambda () (return stream-null)))
     407        (return stream-null)))))
     408</enscript>
    202409
    203410== Input and output
     
    226433functions.
    227434
     435<enscript highlight=scheme filename='stream-ext'>
     436(define (with-output-to-stream proc)
     437  (iterator->stream
     438    (lambda (write close)
     439      (with-output-to-port
     440        (make-output-port
     441          (lambda (string)
     442            (let loop ((i 0))
     443              (when (< i (string-length string))
     444                (write (string-ref string i))
     445                (loop (+ i 1)))))
     446          close)
     447        proc))))
     448</enscript>
     449
     450=== with-input-from-stream
     451
     452 [procedure] (with-input-from-stream stream proc)
     453
     454<enscript highlight=scheme filename='stream-ext'>
     455(define (with-input-from-stream stream proc)
     456  (with-input-from-port
     457    (make-input-port
     458      (lambda ()
     459        (if (stream-null? stream)
     460          #!eof
     461          (let ((char (stream-car stream)))
     462            (set! stream (stream-cdr stream))
     463            char)))
     464      (lambda ()
     465        (not (stream-null? stream)))
     466      (lambda ()
     467        (set! stream stream-null))
     468      (lambda ()
     469        (stream-car stream)))
     470    proc))
     471</enscript>
     472
    228473=== write-stream
    229474
     
    239484but {{write}} and {{write-line}} can also be used (depending
    240485on the contents of {{stream}}).
     486
     487<enscript highlight=scheme filename='stream-ext'>
     488(define (write-stream stream . rest)
     489  (let-optionals rest ((port (current-output-port)) (writer write-char))
     490    (let loop ((s stream))
     491      (unless (stream-null? s)
     492        (writer (stream-car s) port)
     493        (loop (stream-cdr s))))))
     494</enscript>
    241495
    242496== Predicates
     
    283537=> #t</enscript>
    284538
     539<enscript highlight=scheme filename='stream-ext'>
     540(define (stream= elt= . strs)
     541  (or (every stream-null? strs)
     542      (and (not (any stream-null? strs))
     543           (let loop ((es (map stream-car strs)))
     544             (or (null? (cdr es))
     545                 (and (elt= (car es) (cadr es)) (loop (cdr es)))))
     546           (apply stream= elt= (map stream-cdr strs)))))
     547</enscript>
     548
    285549=== stream-prefix=
    286550
     
    302566(stream-prefix= (stream 1 2 3 4) '(1 3))
    303567=> #f</enscript>
     568
     569<enscript highlight=scheme filename='stream-ext'>
     570(define (stream-prefix= str prefix . rest)
     571  (if (null? prefix)
     572    str
     573    (and (not (stream-null? str))
     574         ((if (null? rest) equal? (car rest)) (stream-car str) (car prefix))
     575         (apply stream-prefix= (stream-cdr str) (cdr prefix) rest))))
     576</enscript>
     577
     578=== stream>, stream<
     579
     580...
     581
     582<enscript highlight=scheme filename='stream-ext'>
     583(define (stream< elt< . strs)
     584  (or (null? strs)
     585      (null? (cdr strs))
     586      (and
     587        (let loop ((a (car strs)) (b (cadr strs)))
     588          (or (elt< (stream-car a) (stream-car b))
     589              (and (not (elt< (stream-car b) (stream-car a)))
     590                   (loop (stream-cdr a) (stream-cdr b)))))
     591        (apply stream< elt (cdr strs)))))
     592
     593(define (stream> elt< . strs) (apply stream< (complement elt<) strs))
     594</enscript>
    304595
    305596== Selectors
     
    322613There are twenty-eight of these procedures in all.
    323614
     615<enscript highlight=scheme filename='stream-ext'>
     616(define stream-caar   (compose stream-car stream-car))
     617(define stream-cadr   (compose stream-car stream-cdr))
     618(define stream-cdar   (compose stream-cdr stream-car))
     619(define stream-cddr   (compose stream-cdr stream-cdr))
     620
     621(define stream-caaar  (compose stream-caar stream-car))
     622(define stream-caadr  (compose stream-caar stream-cdr))
     623(define stream-cadar  (compose stream-cadr stream-car))
     624(define stream-caddr  (compose stream-cadr stream-cdr))
     625(define stream-cdaar  (compose stream-cdar stream-car))
     626(define stream-cdadr  (compose stream-cdar stream-cdr))
     627(define stream-cddar  (compose stream-cddr stream-car))
     628(define stream-cdddr  (compose stream-cddr stream-cdr))
     629
     630(define stream-caaaar (compose stream-caaar stream-car))
     631(define stream-caaadr (compose stream-caaar stream-cdr))
     632(define stream-caadar (compose stream-caadr stream-car))
     633(define stream-caaddr (compose stream-caadr stream-cdr))
     634(define stream-cadaar (compose stream-cadar stream-car))
     635(define stream-cadadr (compose stream-cadar stream-cdr))
     636(define stream-caddar (compose stream-caddr stream-car))
     637(define stream-cadddr (compose stream-caddr stream-cdr))
     638(define stream-cdaaar (compose stream-cdaar stream-car))
     639(define stream-cdaadr (compose stream-cdaar stream-cdr))
     640(define stream-cdadar (compose stream-cdadr stream-car))
     641(define stream-cdaddr (compose stream-cdadr stream-cdr))
     642(define stream-cddaar (compose stream-cddar stream-car))
     643(define stream-cddadr (compose stream-cddar stream-cdr))
     644(define stream-cdddar (compose stream-cdddr stream-car))
     645(define stream-cddddr (compose stream-cdddr stream-cdr))
     646</enscript>
     647
    324648=== stream-ref
    325649
     
    333657<enscript highlight=scheme>(stream-ref (stream 0 1 2 3 4 5) 3)
    334658=> 3</enscript>
     659
     660<enscript highlight=scheme filename='stream-ext'>
     661(define (stream-ref str pos)
     662  (if (zero? pos)
     663      (stream-car str)
     664      (stream-ref (stream-cdr str) (- pos 1))))
     665</enscript>
    335666
    336667=== stream-first ... stream-tenth
     
    348679=> 2</enscript>
    349680
    350 === stream-take
     681<enscript highlight=scheme filename='stream-ext'>
     682(define stream-first  stream-car)
     683(define stream-second stream-cadr)
     684(define stream-third  stream-caddr)
     685(define stream-fourth stream-cadddr)
     686(define (stream-fifth   x) (stream-car    (stream-cddddr x)))
     687(define (stream-sixth   x) (stream-cadr   (stream-cddddr x)))
     688(define (stream-seventh x) (stream-caddr  (stream-cddddr x)))
     689(define (stream-eighth  x) (stream-cadddr (stream-cddddr x)))
     690(define (stream-ninth   x) (stream-car  (stream-cddddr (stream-cddddr x))))
     691(define (stream-tenth   x) (stream-cadr (stream-cddddr (stream-cddddr x))))
     692</enscript>
     693
     694=== stream-take, stream-take-safe
    351695
    352696 [procedure] (stream-take str count)
     697 [procedure] (stream-take-safe str count)
    353698
    354699Returns a stream with the first {{count}} elements
    355 in stream {{str}}.  It is an error if {{str}}
    356 has fewer than {{count}} elements.
     700in stream {{str}}.  For {{stream-take}}, it is an error if {{str}}
     701has fewer than {{count}} elements; for {{stream-take-safe}}, {{str}}
     702will be returned.
    357703
    358704<enscript highlight=scheme>(stream-take (stream 1 2 3 4 5) 2)
    359705=> #<stream (1 2)></enscript>
    360706
    361 === stream-drop
     707<enscript highlight=scheme filename='stream-ext'>
     708(define (stream-take stream count)
     709  (stream-delay
     710   (if (zero? count)
     711       stream-null
     712       (stream-cons (stream-car stream)
     713                    (stream-take (stream-cdr stream) (- count 1))))))
     714
     715(define (stream-take-safe stream count)
     716  (stream-delay
     717    (if (or (zero? count) (stream-null? stream))
     718      stream-null
     719      (stream-cons (stream-car stream)
     720                   (stream-take-safe (stream-cdr stream) (- count 1))))))
     721</enscript>
     722
     723=== stream-drop, stream-drop-safe
    362724
    363725 [procedure] (stream-drop str count)
     726 [procedure] (stream-drop-safe str count)
    364727
    365728Returns the sub-stream of {{str}} obtained by omitting
    366 the first {{count}} elements. It is an error if list has
    367 fewer than {{count}} elements.
     729the first {{count}} elements.  For {{stream-drop}}, it is an error if {str}} has
     730fewer than {{count}} elements; for {{stream-drop-safe}}, the empty stream
     731will be returned.
    368732
    369733<enscript highlight=scheme>(stream-drop (stream 0 1 2 3 4 5) 3)
    370734=> #<stream (3 4 5)></enscript>
     735
     736<enscript highlight=scheme filename='stream-ext'>
     737(define (stream-drop str count)
     738  (stream-delay
     739   (if (zero? count)
     740       str
     741       (stream-drop (stream-cdr str) (- count 1)))))
     742
     743(define (stream-drop-safe str count)
     744  (stream-delay
     745    (if (or (zero? count) (stream-null? str))
     746      str
     747      (stream-drop-safe (stream-cdr str) (- count 1)))))
     748
     749
     750
     751</enscript>
    371752
    372753=== stream-intersperse
     
    381762(stream-intersperse (stream 0) 1)
    382763=> #<stream (0)></enscript>
     764
     765<enscript highlight=scheme filename='stream-ext'>
     766(define (stream-intersperse stream element . rest)
     767  (let-optionals rest ((tail stream-null))
     768    (stream-delay
     769      (if (stream-null? stream)
     770        tail
     771        (stream-cons (stream-car stream)
     772          (let loop ((rest (stream-cdr stream)))
     773            (if (stream-null? rest)
     774              tail
     775              (stream-cons element (stream-cons (stream-car rest) (loop (stream-cdr rest)))))))))))
     776</enscript>
    383777
    384778=== stream-split
     
    397791=> #<stream (#<stream (1)> #<stream (3 5 7)> #<stream (9)>)></enscript>
    398792
     793<enscript highlight=scheme filename='stream-ext'>
     794(define (stream-split in p?)
     795  (let loop ((current '()) (s in))
     796    (stream-delay
     797      (cond
     798        ((stream-null? s)
     799           (if (null? current)
     800             stream-null
     801             (stream-cons (list->stream (reverse current)) stream-null)))
     802        ((p? (stream-car s))
     803           (stream-cons (list->stream (reverse current)) (loop '() (stream-cdr s))))
     804        (else (loop (cons (stream-car s) current) (stream-cdr s)))))))
     805</enscript>
     806
    399807=== stream-last
    400808
     
    407815=> c</enscript>
    408816
    409 {{stream-last}} can be defined as:
     817{{stream-last}} could be defined as:
    410818
    411819<enscript highlight=scheme>(define (stream-last stream)
    412820  (stream-car (stream-last-n stream 1)))</enscript>
     821
     822<enscript highlight=scheme filename='stream-ext'>
     823(define (stream-last str)
     824  (if (stream-null? (stream-cdr str))
     825    (stream-car str)
     826    (stream-last (stream-cdr str))))
     827</enscript>
    413828
    414829=== stream-last-n
     
    430845=> #<stream (#\a #\b #\c #\d)></enscript>
    431846
     847<enscript highlight=scheme filename='stream-ext'>
     848(define (stream-last-n str count)
     849  (stream-delay
     850    (let ((l (list #f)))
     851      (set-cdr! l l)
     852      (let loop ((s str) (l l) (i 0))
     853        (cond
     854          ((stream-null? s)
     855           (if (< i count)
     856             str
     857             (stream-take (list->stream (cdr l)) i)))
     858          ((equal? i count)
     859             (set-car! l (stream-car s))
     860             (loop (stream-cdr s) (cdr l) i))
     861          (else
     862            (set-car! l (stream-car s))
     863            (set-cdr! l (cons i (cdr l)))
     864            (loop (stream-cdr s) (cdr l) (+ i 1))))))))
     865</enscript>
     866
    432867=== stream-butlast
    433868
     
    443878{{stream-butlast}} can be defined as:
    444879
    445 <enscript highlight=scheme>(define (stream-butlast stream)
    446   (stream-car (stream-butlast-n stream 1)))</enscript>
     880<enscript highlight=scheme filename='stream-ext'>
     881(define (stream-butlast str)
     882  (stream-butlast-n str 1))
     883</enscript>
    447884
    448885=== stream-butlast-n
     
    461898=> #t</enscript>
    462899
     900<enscript highlight=scheme filename='stream-ext'>
     901(define (stream-butlast-n str count)
     902  (stream-delay
     903    (let loop ((head str) (tail (stream-drop str count)))
     904      (if (stream-null? tail)
     905        stream-null
     906        (stream-cons (stream-car head) (loop (stream-cdr head) (stream-cdr tail)))))))
     907</enscript>
     908
    463909== Miscellaneous: length, append, concatenate, reverse, zip & count
    464910
     
    480926=> 4</enscript>
    481927
     928<enscript highlight=scheme filename='stream-ext'>
     929(define (stream-length str)
     930  (let loop ((i 0) (s str))
     931    (if (stream-null? s)
     932        i
     933        (loop (+ i 1) (stream-cdr s)))))
     934</enscript>
     935
    482936=== stream-length>=
    483937
     
    487941is greater or equal than {{len}}, {{#f}} otherwise.
    488942
    489 For finite streams, this is equivalent, albeit faster, to:
     943For finite streams, this is equivalent, albeit faster (specially when
     944{{len}} is significantly smaller than the length of {{str}}), to:
    490945
    491946<enscript highlight=scheme>(>= (stream-length str) len)</enscript>
     
    493948However, for infinite streams it is equivalent to {{#t}}
    494949(whereas the above code would never terminate).
     950
     951<enscript highlight=scheme filename='stream-ext'>
     952(define (stream-length>= str len)
     953  (or (zero? len)
     954      (and (not (stream-null? str))
     955           (stream-length>= (stream-cdr str) (- len 1)))))
     956</enscript>
    495957
    496958=== stream-append
     
    508970=> #<stream (a (b) (c))></enscript>
    509971
     972<enscript highlight=scheme filename='stream-ext'>
     973(define (stream-append . strs)
     974  (stream-delay
     975    (cond
     976      ((null? strs) stream-null)
     977      ((null? (cdr strs)) (car strs))
     978      (else
     979        (let loop ((c (car strs)) (rest (cdr strs)))
     980          (stream-delay
     981            (if (stream-null? c)
     982              (apply stream-append rest)
     983              (stream-cons (stream-car c) (loop (stream-cdr c) rest)))))))))
     984</enscript>
     985
    510986=== stream-concatenate
    511987
     
    513989
    514990...
     991
     992<enscript highlight=scheme filename='stream-ext'>
     993(define (stream-concatenate strs)
     994  (stream-delay
     995    (if (stream-null? strs)
     996      stream-null
     997      (stream-append (stream-car strs) (stream-concatenate (stream-cdr strs))))))
     998</enscript>
    515999
    5161000=== stream-reverse
     
    5301014=> #<stream ((e (f)) d (b c) a)></enscript>
    5311015
    532 === stream-append-reverse
    533 
    534  [procedure] (stream-append-reverse rev-head tail)
    535 
    536 {{stream-append-reverse}} returns
    537 {{(stream-append (stream-reverse rev-head) tail)}}.
    538 It is
    539 provided because it is a common operation -- a common list-processing style
    540 calls for this exact operation to transfer values accumulated in reverse order
    541 onto the front of another list, and because the implementation is significantly
    542 more efficient than the simple composition it replaces.
    543 
    544 This procedure does not return if {{rev-head}} is an infinite stream.
     1016<enscript highlight=scheme filename='stream-ext'>
     1017(define (stream-reverse str . args)
     1018  (stream-delay
     1019    (let-optionals args ((tail stream-null))
     1020      (let loop ((head str) (tail tail))
     1021        (if (stream-null? head)
     1022          tail
     1023          (loop (stream-cdr head) (stream-cons (stream-car head) tail)))))))
     1024</enscript>
    5451025
    5461026=== stream-count
     
    5641044=> 2</enscript>
    5651045
     1046<enscript highlight=scheme filename='stream-ext'>
     1047(define (stream-count pred . strs)
     1048  (apply
     1049    stream-fold
     1050    (lambda args
     1051      (+ (last args)
     1052         (if (apply pred (butlast args)) 1 0)))
     1053    0
     1054    strs)
     1055</enscript>
     1056
     1057== Fold
     1058
     1059=== stream-fold
     1060
     1061...
     1062
     1063<enscript highlight=scheme filename='stream-ext'>
     1064(define (stream-fold func nil . strs)
     1065  (if (any stream-null? str)
     1066    nil
     1067    (apply
     1068      stream-fold
     1069      func
     1070      (apply (cut func <...> nil) (map stream-car strs))
     1071      (map stream-cdr strs))))
     1072</enscript>
     1073
     1074=== stream-fold-right
     1075
     1076...
     1077
     1078<enscript highlight=scheme filename='stream-ext'>
     1079(define (stream-fold-right func nil str)
     1080  (if (stream-null? str)
     1081    nil
     1082    (func (stream-car str) (stream-fold-right func nil (stream-cdr str)))))
     1083</enscript>
     1084
     1085=== stream-fold-right-delay
     1086
     1087...
     1088
     1089Similar to {{stream-fold-right}}, but useful when the result of the folding
     1090procedure is a stream; in this case, the evaluation of the fold is done in a
     1091lazy manner.
     1092
     1093<enscript highlight=scheme filename='stream-ext'>
     1094(define (stream-fold-right-delay func nil str)
     1095  (stream-delay
     1096    (if (stream-null? str)
     1097      nil
     1098      (func (stream-car str) (stream-fold-right-delay func nil (stream-cdr str))))))
     1099</enscript>
     1100
    5661101== Filtering & Partitioning
    5671102
     
    5851120   #<stream (2 3 6)></enscript>
    5861121
     1122<enscript highlight=scheme filename='stream-ext'>
     1123(define (stream-partition pred str)
     1124  (values (stream-filter pred str)
     1125          (stream-remove pred str)))
     1126</enscript>
     1127
    5871128=== stream-remove
    5881129
     
    5991140<enscript highlight=scheme>(stream-remove even? (stream 0 7 8 8 43 -4))
    6001141=> #<stream (7 43)></enscript>
     1142
     1143<enscript highlight=scheme filename='stream-ext'>
     1144(define (stream-remove pred str)
     1145  (stream-filter (complement pred) str))
     1146</enscript>
    6011147
    6021148== Searching
     
    6271173      (else ...)) ; Search failed.</enscript>
    6281174
     1175<enscript highlight=scheme filename='stream-ext'>
     1176(define (stream-find pred str)
     1177  (let ((result (stream-find-tail pred str)))
     1178    (and result (stream-car result))))
     1179</enscript>
     1180
    6291181=== stream-find-tail
    6301182
     
    6521204element that doesn't satisfy the predicate.
    6531205
     1206<enscript highlight=scheme filename='stream-ext'>
     1207(define (stream-find-tail pred str)
     1208  (and (not (stream-null? str))
     1209       (if (pred (stream-car str))
     1210           str
     1211           (stream-find-tail pred (stream-cdr str)))))
     1212</enscript>
     1213
    6541214=== stream-take-while
    6551215
     
    6611221<enscript highlight=scheme>(stream-take-while even? (stream 2 18 3 10 22 9))
    6621222=> #<stream (2 18)></enscript>
     1223
     1224<enscript highlight=scheme filename='stream-ext'>
     1225(define (stream-take-while pred str)
     1226  (stream-delay
     1227   (if (or (stream-null? str) (not (pred (stream-car str))))
     1228       stream-null
     1229       (stream-cons (stream-car str)
     1230         (stream-take-while pred (stream-cdr str))))))
     1231</enscript>
    6631232
    6641233=== stream-drop-while
     
    6721241<enscript highlight=scheme>(stream-drop-while even? (stream 2 18 3 10 22 9))
    6731242=> #<stream (3 10 22 9)></enscript>
     1243
     1244<enscript highlight=scheme filename='stream-ext'>
     1245(define (stream-drop-while pred str)
     1246  (stream-delay
     1247   (if (or (stream-null? str) (not (pred (stream-car str))))
     1248       str
     1249       (stream-drop-while pred (stream-cdr str)))))
     1250</enscript>
    6741251
    6751252=== stream-span, stream-break
     
    7031280  #<stream (4 1 5 9)></enscript>
    7041281
     1282<enscript highlight=scheme filename='stream-ext'>
     1283(define (stream-span pred str)
     1284  (values (stream-take-while pred str) (stream-drop-while pred str)))
     1285
     1286(define (stream-break pred str)
     1287  (stream-span (complement pred) str))
     1288</enscript>
     1289
    7051290=== stream-any
    7061291
     
    7481333=> #t</enscript>
    7491334
     1335<enscript highlight=scheme filename='stream-ext'>
     1336(define (stream-any pred . strs)
     1337  (and (not (find stream-null? strs))
     1338       (or (apply pred (map stream-car strs))
     1339           (apply stream-any pred (map stream-cdr strs)))))
     1340</enscript>
     1341
    7501342=== stream-every
    7511343
     
    7811373that it does not return a simple boolean (#t or #f), but a general value.
    7821374
     1375<enscript highlight=scheme filename='stream-ext'>
     1376(define (stream-every pred . strs)
     1377  (let loop ((strs strs))
     1378    (or (find stream-null? strs)
     1379        (and (apply pred (map stream-car strs))
     1380             (loop (map stream-cdr strs))))))
     1381</enscript>
     1382
    7831383=== stream-index
    7841384
     
    8101410(stream-index = (stream 3 1 4 1 5 9 2 5 6) (stream 2 7 1 8 2))
    8111411=> #f</enscript>
     1412
     1413<enscript highlight=scheme filename='stream-ext'>
     1414(define (stream-index pred . strs)
     1415  (let loop ((strs strs) (pos 0))
     1416    (and (not (find stream-null? strs))
     1417         (if (apply pred (map stream-car strs))
     1418             pos
     1419             (loop (map stream-cdr strs) (+ pos 1))))))
     1420</enscript>
    8121421
    8131422=== stream-member, stream-memq, stream-memv
     
    8621471(stream-find-tail even? str)</enscript>
    8631472
     1473<enscript highlight=scheme filename='stream-ext'>
     1474(define (stream-member-real x str =)
     1475  (stream-find-tail (cut = x <>) str))
     1476
     1477(define (stream-member x str . rest)
     1478  (stream-member-real x str (if (null? rest) equal? (car rest))))
     1479
     1480(define stream-memq (cut stream-member-real <...> eq?))
     1481(define stream-memv (cut stream-member-real <...> eqv?))
     1482</enscript>
     1483
     1484== Sorting
     1485
     1486=== stream-sort
     1487
     1488 [procedure] (stream-sort str <)
     1489
     1490Returns a copy of {{str}} with its elements sorted.
     1491
     1492We don't care about the slowness of converting to a list and then back to a
     1493stream since
     1494
     1495* The entire set of elements will be needed in memory and
     1496
     1497* Sort has greater algorithmical complexity {{O(N) = N*log(N)}}
     1498than the conversions.
     1499
     1500<enscript highlight=scheme filename='stream-ext'>
     1501(define (stream-sort stream ord)
     1502  (list->stream (sort (stream->list stream) ord)))
     1503</enscript>
     1504
    8641505== Strings as streams
    8651506
     
    8711512with all characters converted to lowercase.
    8721513
     1514<enscript highlight=scheme filename='stream-ext'>
     1515(define stream-downcase (cut stream-map char-downcase <>))
     1516</enscript>
     1517
    8731518=== stream-upcase
    8741519
     
    8771522Returns a stream identical to the stream of characters {{str}} but
    8781523with all characters converted to uppercase.
     1524
     1525<enscript highlight=scheme filename='stream-ext'>
     1526(define stream-upcase   (cut stream-map char-upcase   <>))
     1527</enscript>
    8791528
    8801529== Deletion
     
    9011550is always the second argument.  Thus, one can reliably remove all the numbers
    9021551greater than five from a stream with {{(delete 5 stream <)}}.
     1552
     1553<enscript highlight=scheme filename='stream-ext'>
     1554(define (stream-delete x str . rest)
     1555  (stream-remove
     1556    (let ((= (if (null? rest) equal? (car rest))))
     1557      (lambda (elt) (= x elt)))
     1558    str))
     1559</enscript>
    9031560
    9041561=== stream-delete-duplicates
     
    9311588<enscript highlight=scheme>(stream-delete-duplicates (stream 0 1 0 3 0 1 3 4))
    9321589=> #<stream (0 1 3 4)></enscript>
     1590
     1591<enscript highlight=scheme filename='stream-ext'>
     1592(define (stream-delete-duplicates str . rest)
     1593  (stream-delete-dups str '() (if (null? rest) equal? (car rest))))
     1594
     1595(define (stream-delete-dups str already =)
     1596  (stream-delay
     1597    (cond
     1598      ((stream-null? str) stream-null)
     1599      ((any (lambda (x) (= x (stream-car str))) already)
     1600       (stream-delete-dups (stream-cdr str) already =))
     1601      (else
     1602        (stream-cons (stream-car str)
     1603                     (stream-delete-dups (stream-cdr str) (cons (stream-car str) already) =))))))
     1604</enscript>
     1605
     1606== Other undocumented code
     1607
     1608The following procedures are also provided.
     1609
     1610TODO: Move them to the appropriate sections in this document and get rid of this section.
     1611
     1612<enscript highlight=scheme filename='stream-ext'>
     1613(define (stream-convert-safe check? convert)
     1614  (lambda (obj)
     1615    (if (check? obj)
     1616      (convert obj)
     1617      obj)))
     1618
     1619(define (stream-wrap-proc-generic convert-inputs convert-outputs)
     1620  (lambda (proc)
     1621    (lambda args
     1622      (receive results
     1623               (apply proc (map convert-inputs args))
     1624        (apply values (map convert-outputs results))))))
     1625
     1626(define stream-wrap-proc-string
     1627  (stream-wrap-proc-generic
     1628    (stream-convert-safe stream? stream->string)
     1629    (stream-convert-safe string? string->stream)))
     1630
     1631(define stream-wrap-proc-list
     1632  (stream-wrap-proc-generic
     1633    (stream-convert-safe stream? stream->list)
     1634    (stream-convert-safe list? list->stream)))
     1635
     1636(define stream-wrap-proc-stream
     1637  (stream-wrap-proc-generic
     1638    (lambda (obj)
     1639      (cond
     1640        ((list? obj) (list->stream obj))
     1641        ((string? obj) (string->stream obj))
     1642        (else obj)))
     1643    identity))
     1644
     1645;;; Pattern Matching
     1646
     1647(define (stream-grep re stream)
     1648  (let ((real-re (if (string? re) (regexp re) re)))
     1649    (stream-filter (cut string-match real-re <>) stream)))
     1650
     1651; (equal? tail stream-null) rather than (stream-null? tail) to avoid an
     1652; off-by-one error (evaluating tail before obj is fully consumed).
     1653
     1654(define (->stream-char obj . rest)
     1655  (stream-delay
     1656   (let-optionals rest ((tail stream-null))
     1657     (cond
     1658      ((string? obj) (string->stream obj tail))
     1659      ((or (number? obj) (boolean? obj) (symbol? obj)) (->stream-char (->string obj) tail))
     1660      ((char? obj) (stream-cons obj tail))
     1661      ((port? obj) (port->stream obj))
     1662      ((stream? obj)
     1663       (if (equal? tail stream-null)
     1664           obj
     1665           (stream-append obj tail)))
     1666      (else (error "Unable to convert object to stream-char" obj))))))
     1667
     1668(define (stream-replace in reps)
     1669  (if (stream-null? in)
     1670      stream-null
     1671      (let ((obj (assoc (stream-car in) reps)))
     1672        (if obj
     1673            (->stream-char (cadr obj) (stream-replace (stream-cdr in) reps))
     1674            (stream-cons (stream-car in) (stream-replace (stream-cdr in) reps))))))
     1675
     1676(define (stream-translate str from to)
     1677  (stream-map (lambda (c) (if (equal? c from) to c)) str))
     1678</enscript>
    9331679
    9341680== Version History
Note: See TracChangeset for help on using the changeset viewer.