Artifact
dcf15fed2012513d118e585c07b5bc657a2ac91a:
0000: 23 21 72 36 72 73 20 0a 3b 3b 3b 20 43 6f 70 79 #!r6rs .;;; Copy
0010: 72 69 67 68 74 20 28 43 29 20 50 68 69 6c 69 70 right (C) Philip
0020: 20 4c 2e 20 42 65 77 69 67 20 28 32 30 30 37 29 L. Bewig (2007)
0030: 2e 20 41 6c 6c 20 52 69 67 68 74 73 20 52 65 73 . All Rights Res
0040: 65 72 76 65 64 2e 0a 3b 3b 3b 20 50 65 72 6d 69 erved..;;; Permi
0050: 73 73 69 6f 6e 20 69 73 20 68 65 72 65 62 79 20 ssion is hereby
0060: 67 72 61 6e 74 65 64 2c 20 66 72 65 65 20 6f 66 granted, free of
0070: 20 63 68 61 72 67 65 2c 20 74 6f 20 61 6e 79 20 charge, to any
0080: 70 65 72 73 6f 6e 0a 3b 3b 3b 20 6f 62 74 61 69 person.;;; obtai
0090: 6e 69 6e 67 20 61 20 63 6f 70 79 20 6f 66 20 74 ning a copy of t
00a0: 68 69 73 20 73 6f 66 74 77 61 72 65 20 61 6e 64 his software and
00b0: 20 61 73 73 6f 63 69 61 74 65 64 20 64 6f 63 75 associated docu
00c0: 6d 65 6e 74 61 74 69 6f 6e 20 66 69 6c 65 73 0a mentation files.
00d0: 3b 3b 3b 20 28 74 68 65 20 22 53 6f 66 74 77 61 ;;; (the "Softwa
00e0: 72 65 22 29 2c 20 74 6f 20 64 65 61 6c 20 69 6e re"), to deal in
00f0: 20 74 68 65 20 53 6f 66 74 77 61 72 65 20 77 69 the Software wi
0100: 74 68 6f 75 74 20 72 65 73 74 72 69 63 74 69 6f thout restrictio
0110: 6e 2c 0a 3b 3b 3b 20 69 6e 63 6c 75 64 69 6e 67 n,.;;; including
0120: 20 77 69 74 68 6f 75 74 20 6c 69 6d 69 74 61 74 without limitat
0130: 69 6f 6e 20 74 68 65 20 72 69 67 68 74 73 20 74 ion the rights t
0140: 6f 20 75 73 65 2c 20 63 6f 70 79 2c 20 6d 6f 64 o use, copy, mod
0150: 69 66 79 2c 20 6d 65 72 67 65 2c 0a 3b 3b 3b 20 ify, merge,.;;;
0160: 70 75 62 6c 69 73 68 2c 20 64 69 73 74 72 69 62 publish, distrib
0170: 75 74 65 2c 20 73 75 62 6c 69 63 65 6e 73 65 2c ute, sublicense,
0180: 20 61 6e 64 2f 6f 72 20 73 65 6c 6c 20 63 6f 70 and/or sell cop
0190: 69 65 73 20 6f 66 20 74 68 65 20 53 6f 66 74 77 ies of the Softw
01a0: 61 72 65 2c 0a 3b 3b 3b 20 61 6e 64 20 74 6f 20 are,.;;; and to
01b0: 70 65 72 6d 69 74 20 70 65 72 73 6f 6e 73 20 74 permit persons t
01c0: 6f 20 77 68 6f 6d 20 74 68 65 20 53 6f 66 74 77 o whom the Softw
01d0: 61 72 65 20 69 73 20 66 75 72 6e 69 73 68 65 64 are is furnished
01e0: 20 74 6f 20 64 6f 20 73 6f 2c 0a 3b 3b 3b 20 73 to do so,.;;; s
01f0: 75 62 6a 65 63 74 20 74 6f 20 74 68 65 20 66 6f ubject to the fo
0200: 6c 6c 6f 77 69 6e 67 20 63 6f 6e 64 69 74 69 6f llowing conditio
0210: 6e 73 3a 0a 3b 3b 3b 20 0a 3b 3b 3b 20 54 68 65 ns:.;;; .;;; The
0220: 20 61 62 6f 76 65 20 63 6f 70 79 72 69 67 68 74 above copyright
0230: 20 6e 6f 74 69 63 65 20 61 6e 64 20 74 68 69 73 notice and this
0240: 20 70 65 72 6d 69 73 73 69 6f 6e 20 6e 6f 74 69 permission noti
0250: 63 65 20 73 68 61 6c 6c 20 62 65 0a 3b 3b 3b 20 ce shall be.;;;
0260: 69 6e 63 6c 75 64 65 64 20 69 6e 20 61 6c 6c 20 included in all
0270: 63 6f 70 69 65 73 20 6f 72 20 73 75 62 73 74 61 copies or substa
0280: 6e 74 69 61 6c 20 70 6f 72 74 69 6f 6e 73 20 6f ntial portions o
0290: 66 20 74 68 65 20 53 6f 66 74 77 61 72 65 2e 0a f the Software..
02a0: 3b 3b 3b 20 0a 3b 3b 3b 20 54 48 45 20 53 4f 46 ;;; .;;; THE SOF
02b0: 54 57 41 52 45 20 49 53 20 50 52 4f 56 49 44 45 TWARE IS PROVIDE
02c0: 44 20 22 41 53 20 49 53 22 2c 20 57 49 54 48 4f D "AS IS", WITHO
02d0: 55 54 20 57 41 52 52 41 4e 54 59 20 4f 46 20 41 UT WARRANTY OF A
02e0: 4e 59 20 4b 49 4e 44 2c 0a 3b 3b 3b 20 45 58 50 NY KIND,.;;; EXP
02f0: 52 45 53 53 20 4f 52 20 49 4d 50 4c 49 45 44 2c RESS OR IMPLIED,
0300: 20 49 4e 43 4c 55 44 49 4e 47 20 42 55 54 20 4e INCLUDING BUT N
0310: 4f 54 20 4c 49 4d 49 54 45 44 20 54 4f 20 54 48 OT LIMITED TO TH
0320: 45 20 57 41 52 52 41 4e 54 49 45 53 20 4f 46 0a E WARRANTIES OF.
0330: 3b 3b 3b 20 4d 45 52 43 48 41 4e 54 41 42 49 4c ;;; MERCHANTABIL
0340: 49 54 59 2c 20 46 49 54 4e 45 53 53 20 46 4f 52 ITY, FITNESS FOR
0350: 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 A PARTICULAR PU
0360: 52 50 4f 53 45 20 41 4e 44 0a 3b 3b 3b 20 4e 4f RPOSE AND.;;; NO
0370: 4e 49 4e 46 52 49 4e 47 45 4d 45 4e 54 2e 20 49 NINFRINGEMENT. I
0380: 4e 20 4e 4f 20 45 56 45 4e 54 20 53 48 41 4c 4c N NO EVENT SHALL
0390: 20 54 48 45 20 41 55 54 48 4f 52 53 20 4f 52 20 THE AUTHORS OR
03a0: 43 4f 50 59 52 49 47 48 54 20 48 4f 4c 44 45 52 COPYRIGHT HOLDER
03b0: 53 0a 3b 3b 3b 20 42 45 20 4c 49 41 42 4c 45 20 S.;;; BE LIABLE
03c0: 46 4f 52 20 41 4e 59 20 43 4c 41 49 4d 2c 20 44 FOR ANY CLAIM, D
03d0: 41 4d 41 47 45 53 20 4f 52 20 4f 54 48 45 52 20 AMAGES OR OTHER
03e0: 4c 49 41 42 49 4c 49 54 59 2c 20 57 48 45 54 48 LIABILITY, WHETH
03f0: 45 52 20 49 4e 20 41 4e 0a 3b 3b 3b 20 41 43 54 ER IN AN.;;; ACT
0400: 49 4f 4e 20 4f 46 20 43 4f 4e 54 52 41 43 54 2c ION OF CONTRACT,
0410: 20 54 4f 52 54 20 4f 52 20 4f 54 48 45 52 57 49 TORT OR OTHERWI
0420: 53 45 2c 20 41 52 49 53 49 4e 47 20 46 52 4f 4d SE, ARISING FROM
0430: 2c 20 4f 55 54 20 4f 46 20 4f 52 20 49 4e 0a 3b , OUT OF OR IN.;
0440: 3b 3b 20 43 4f 4e 4e 45 43 54 49 4f 4e 20 57 49 ;; CONNECTION WI
0450: 54 48 20 54 48 45 20 53 4f 46 54 57 41 52 45 20 TH THE SOFTWARE
0460: 4f 52 20 54 48 45 20 55 53 45 20 4f 52 20 4f 54 OR THE USE OR OT
0470: 48 45 52 20 44 45 41 4c 49 4e 47 53 20 49 4e 20 HER DEALINGS IN
0480: 54 48 45 0a 3b 3b 3b 20 53 4f 46 54 57 41 52 45 THE.;;; SOFTWARE
0490: 2e 0a 0a 28 6c 69 62 72 61 72 79 20 28 73 72 66 ...(library (srf
04a0: 69 20 73 34 31 20 73 74 72 65 61 6d 73 20 64 65 i s41 streams de
04b0: 72 69 76 65 64 29 0a 0a 20 20 28 65 78 70 6f 72 rived).. (expor
04c0: 74 20 73 74 72 65 61 6d 2d 6e 75 6c 6c 20 73 74 t stream-null st
04d0: 72 65 61 6d 2d 63 6f 6e 73 20 73 74 72 65 61 6d ream-cons stream
04e0: 3f 20 73 74 72 65 61 6d 2d 6e 75 6c 6c 3f 20 73 ? stream-null? s
04f0: 74 72 65 61 6d 2d 70 61 69 72 3f 20 73 74 72 65 tream-pair? stre
0500: 61 6d 2d 63 61 72 0a 20 20 20 20 20 20 20 20 20 am-car.
0510: 20 73 74 72 65 61 6d 2d 63 64 72 20 73 74 72 65 stream-cdr stre
0520: 61 6d 2d 6c 61 6d 62 64 61 20 64 65 66 69 6e 65 am-lambda define
0530: 2d 73 74 72 65 61 6d 20 6c 69 73 74 2d 3e 73 74 -stream list->st
0540: 72 65 61 6d 20 70 6f 72 74 2d 3e 73 74 72 65 61 ream port->strea
0550: 6d 20 73 74 72 65 61 6d 0a 20 20 20 20 20 20 20 m stream.
0560: 20 20 20 73 74 72 65 61 6d 2d 3e 6c 69 73 74 20 stream->list
0570: 73 74 72 65 61 6d 2d 61 70 70 65 6e 64 20 73 74 stream-append st
0580: 72 65 61 6d 2d 63 6f 6e 63 61 74 20 73 74 72 65 ream-concat stre
0590: 61 6d 2d 63 6f 6e 73 74 61 6e 74 20 73 74 72 65 am-constant stre
05a0: 61 6d 2d 64 72 6f 70 0a 20 20 20 20 20 20 20 20 am-drop.
05b0: 20 20 73 74 72 65 61 6d 2d 64 72 6f 70 2d 77 68 stream-drop-wh
05c0: 69 6c 65 20 73 74 72 65 61 6d 2d 66 69 6c 74 65 ile stream-filte
05d0: 72 20 73 74 72 65 61 6d 2d 66 6f 6c 64 20 73 74 r stream-fold st
05e0: 72 65 61 6d 2d 66 6f 72 2d 65 61 63 68 20 73 74 ream-for-each st
05f0: 72 65 61 6d 2d 66 72 6f 6d 0a 20 20 20 20 20 20 ream-from.
0600: 20 20 20 20 73 74 72 65 61 6d 2d 69 74 65 72 61 stream-itera
0610: 74 65 20 73 74 72 65 61 6d 2d 6c 65 6e 67 74 68 te stream-length
0620: 20 73 74 72 65 61 6d 2d 6c 65 74 20 73 74 72 65 stream-let stre
0630: 61 6d 2d 6d 61 70 20 73 74 72 65 61 6d 2d 6d 61 am-map stream-ma
0640: 74 63 68 0a 20 20 20 20 20 20 20 20 20 20 73 74 tch. st
0650: 72 65 61 6d 2d 6f 66 20 73 74 72 65 61 6d 2d 72 ream-of stream-r
0660: 61 6e 67 65 20 73 74 72 65 61 6d 2d 72 65 66 20 ange stream-ref
0670: 73 74 72 65 61 6d 2d 72 65 76 65 72 73 65 20 73 stream-reverse s
0680: 74 72 65 61 6d 2d 73 63 61 6e 20 73 74 72 65 61 tream-scan strea
0690: 6d 2d 74 61 6b 65 0a 20 20 20 20 20 20 20 20 20 m-take.
06a0: 20 73 74 72 65 61 6d 2d 74 61 6b 65 2d 77 68 69 stream-take-whi
06b0: 6c 65 20 73 74 72 65 61 6d 2d 75 6e 66 6f 6c 64 le stream-unfold
06c0: 20 73 74 72 65 61 6d 2d 75 6e 66 6f 6c 64 73 20 stream-unfolds
06d0: 73 74 72 65 61 6d 2d 7a 69 70 29 0a 0a 20 20 28 stream-zip).. (
06e0: 69 6d 70 6f 72 74 20 28 72 6e 72 73 29 20 28 73 import (rnrs) (s
06f0: 72 66 69 20 73 34 31 20 73 74 72 65 61 6d 73 20 rfi s41 streams
0700: 70 72 69 6d 69 74 69 76 65 29 29 0a 0a 20 20 28 primitive)).. (
0710: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 64 65 define-syntax de
0720: 66 69 6e 65 2d 73 74 72 65 61 6d 0a 20 20 20 20 fine-stream.
0730: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules ()
0740: 0a 20 20 20 20 20 20 28 28 64 65 66 69 6e 65 2d . ((define-
0750: 73 74 72 65 61 6d 20 28 6e 61 6d 65 20 2e 20 66 stream (name . f
0760: 6f 72 6d 61 6c 29 20 62 6f 64 79 30 20 62 6f 64 ormal) body0 bod
0770: 79 31 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 y1 ...).
0780: 28 64 65 66 69 6e 65 20 6e 61 6d 65 20 28 73 74 (define name (st
0790: 72 65 61 6d 2d 6c 61 6d 62 64 61 20 66 6f 72 6d ream-lambda form
07a0: 61 6c 20 62 6f 64 79 30 20 62 6f 64 79 31 20 2e al body0 body1 .
07b0: 2e 2e 29 29 29 29 29 0a 0a 20 20 28 64 65 66 69 ..))))).. (defi
07c0: 6e 65 20 28 6c 69 73 74 2d 3e 73 74 72 65 61 6d ne (list->stream
07d0: 20 6f 62 6a 73 29 0a 20 20 20 20 28 64 65 66 69 objs). (defi
07e0: 6e 65 20 6c 69 73 74 2d 3e 73 74 72 65 61 6d 0a ne list->stream.
07f0: 20 20 20 20 20 20 28 73 74 72 65 61 6d 2d 6c 61 (stream-la
0800: 6d 62 64 61 20 28 6f 62 6a 73 29 0a 20 20 20 20 mbda (objs).
0810: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6f (if (null? o
0820: 62 6a 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 bjs).
0830: 20 73 74 72 65 61 6d 2d 6e 75 6c 6c 0a 20 20 20 stream-null.
0840: 20 20 20 20 20 20 20 20 20 28 73 74 72 65 61 6d (stream
0850: 2d 63 6f 6e 73 20 28 63 61 72 20 6f 62 6a 73 29 -cons (car objs)
0860: 20 28 6c 69 73 74 2d 3e 73 74 72 65 61 6d 20 28 (list->stream (
0870: 63 64 72 20 6f 62 6a 73 29 29 29 29 29 29 0a 20 cdr objs)))))).
0880: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 69 73 (if (not (lis
0890: 74 3f 20 6f 62 6a 73 29 29 0a 20 20 20 20 20 20 t? objs)).
08a0: 20 20 28 65 72 72 6f 72 20 27 6c 69 73 74 2d 3e (error 'list->
08b0: 73 74 72 65 61 6d 20 22 6e 6f 6e 2d 6c 69 73 74 stream "non-list
08c0: 20 61 72 67 75 6d 65 6e 74 22 29 0a 20 20 20 20 argument").
08d0: 20 20 20 20 28 6c 69 73 74 2d 3e 73 74 72 65 61 (list->strea
08e0: 6d 20 6f 62 6a 73 29 29 29 0a 0a 20 20 28 64 65 m objs))).. (de
08f0: 66 69 6e 65 20 28 70 6f 72 74 2d 3e 73 74 72 65 fine (port->stre
0900: 61 6d 20 2e 20 70 6f 72 74 29 0a 20 20 20 20 28 am . port). (
0910: 64 65 66 69 6e 65 20 70 6f 72 74 2d 3e 73 74 72 define port->str
0920: 65 61 6d 0a 20 20 20 20 20 20 28 73 74 72 65 61 eam. (strea
0930: 6d 2d 6c 61 6d 62 64 61 20 28 70 29 0a 20 20 20 m-lambda (p).
0940: 20 20 20 20 20 28 6c 65 74 20 28 28 63 20 28 72 (let ((c (r
0950: 65 61 64 2d 63 68 61 72 20 70 29 29 29 0a 20 20 ead-char p))).
0960: 20 20 20 20 20 20 20 20 28 69 66 20 28 65 6f 66 (if (eof
0970: 2d 6f 62 6a 65 63 74 3f 20 63 29 0a 20 20 20 20 -object? c).
0980: 20 20 20 20 20 20 20 20 20 20 73 74 72 65 61 6d stream
0990: 2d 6e 75 6c 6c 0a 20 20 20 20 20 20 20 20 20 20 -null.
09a0: 20 20 20 20 28 73 74 72 65 61 6d 2d 63 6f 6e 73 (stream-cons
09b0: 20 63 20 28 70 6f 72 74 2d 3e 73 74 72 65 61 6d c (port->stream
09c0: 20 70 29 29 29 29 29 29 0a 20 20 20 20 28 6c 65 p)))))). (le
09d0: 74 20 28 28 70 20 28 69 66 20 28 6e 75 6c 6c 3f t ((p (if (null?
09e0: 20 70 6f 72 74 29 20 28 63 75 72 72 65 6e 74 2d port) (current-
09f0: 69 6e 70 75 74 2d 70 6f 72 74 29 20 28 63 61 72 input-port) (car
0a00: 20 70 6f 72 74 29 29 29 29 0a 20 20 20 20 20 20 port)))).
0a10: 28 69 66 20 28 6e 6f 74 20 28 69 6e 70 75 74 2d (if (not (input-
0a20: 70 6f 72 74 3f 20 70 29 29 0a 20 20 20 20 20 20 port? p)).
0a30: 20 20 20 20 28 65 72 72 6f 72 20 27 70 6f 72 74 (error 'port
0a40: 2d 3e 73 74 72 65 61 6d 20 22 6e 6f 6e 2d 69 6e ->stream "non-in
0a50: 70 75 74 2d 70 6f 72 74 20 61 72 67 75 6d 65 6e put-port argumen
0a60: 74 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 70 t"). (p
0a70: 6f 72 74 2d 3e 73 74 72 65 61 6d 20 70 29 29 29 ort->stream p)))
0a80: 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 62 69 ).. (define (bi
0a90: 6e 61 72 79 2d 70 6f 72 74 2d 3e 73 74 72 65 61 nary-port->strea
0aa0: 6d 20 2e 20 70 6f 72 74 29 0a 20 20 20 20 28 64 m . port). (d
0ab0: 65 66 69 6e 65 20 70 6f 72 74 2d 3e 73 74 72 65 efine port->stre
0ac0: 61 6d 0a 20 20 20 20 20 20 28 73 74 72 65 61 6d am. (stream
0ad0: 2d 6c 61 6d 62 64 61 20 28 70 29 0a 20 20 20 20 -lambda (p).
0ae0: 20 20 20 20 28 6c 65 74 20 28 28 63 20 28 67 65 (let ((c (ge
0af0: 74 2d 75 38 20 70 29 29 29 0a 20 20 20 20 20 20 t-u8 p))).
0b00: 20 20 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a (if (eof-obj
0b10: 65 63 74 3f 20 63 29 0a 20 20 20 20 20 20 20 20 ect? c).
0b20: 20 20 20 20 20 20 73 74 72 65 61 6d 2d 6e 75 6c stream-nul
0b30: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 l.
0b40: 28 73 74 72 65 61 6d 2d 63 6f 6e 73 20 63 20 28 (stream-cons c (
0b50: 70 6f 72 74 2d 3e 73 74 72 65 61 6d 20 70 29 29 port->stream p))
0b60: 29 29 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 )))). (let ((
0b70: 70 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 6f 72 p (if (null? por
0b80: 74 29 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 t) (current-inpu
0b90: 74 2d 70 6f 72 74 29 20 28 63 61 72 20 70 6f 72 t-port) (car por
0ba0: 74 29 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 t)))). (if
0bb0: 28 6e 6f 74 20 28 69 6e 70 75 74 2d 70 6f 72 74 (not (input-port
0bc0: 3f 20 70 29 29 0a 20 20 20 20 20 20 20 20 20 20 ? p)).
0bd0: 28 65 72 72 6f 72 20 27 70 6f 72 74 2d 3e 73 74 (error 'port->st
0be0: 72 65 61 6d 20 22 6e 6f 6e 2d 69 6e 70 75 74 2d ream "non-input-
0bf0: 70 6f 72 74 20 61 72 67 75 6d 65 6e 74 22 29 0a port argument").
0c00: 20 20 20 20 20 20 20 20 20 20 28 70 6f 72 74 2d (port-
0c10: 3e 73 74 72 65 61 6d 20 70 29 29 29 29 0a 0a 20 >stream p))))..
0c20: 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 (define-syntax
0c30: 73 74 72 65 61 6d 0a 20 20 20 20 28 73 79 6e 74 stream. (synt
0c40: 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 ax-rules ().
0c50: 20 20 28 28 73 74 72 65 61 6d 29 20 73 74 72 65 ((stream) stre
0c60: 61 6d 2d 6e 75 6c 6c 29 0a 20 20 20 20 20 20 28 am-null). (
0c70: 28 73 74 72 65 61 6d 20 78 20 79 20 2e 2e 2e 29 (stream x y ...)
0c80: 20 28 73 74 72 65 61 6d 2d 63 6f 6e 73 20 78 20 (stream-cons x
0c90: 28 73 74 72 65 61 6d 20 79 20 2e 2e 2e 29 29 29 (stream y ...)))
0ca0: 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 73 )).. (define (s
0cb0: 74 72 65 61 6d 2d 3e 6c 69 73 74 20 2e 20 61 72 tream->list . ar
0cc0: 67 73 29 0a 20 20 20 20 28 6c 65 74 20 28 28 6e gs). (let ((n
0cd0: 20 28 69 66 20 28 3d 20 31 20 28 6c 65 6e 67 74 (if (= 1 (lengt
0ce0: 68 20 61 72 67 73 29 29 20 23 66 20 28 63 61 72 h args)) #f (car
0cf0: 20 61 72 67 73 29 29 29 0a 20 20 20 20 20 20 20 args))).
0d00: 20 20 20 28 73 74 72 6d 20 28 69 66 20 28 3d 20 (strm (if (=
0d10: 31 20 28 6c 65 6e 67 74 68 20 61 72 67 73 29 29 1 (length args))
0d20: 20 28 63 61 72 20 61 72 67 73 29 20 28 63 61 64 (car args) (cad
0d30: 72 20 61 72 67 73 29 29 29 29 0a 20 20 20 20 20 r args)))).
0d40: 20 28 63 6f 6e 64 20 28 28 6e 6f 74 20 28 73 74 (cond ((not (st
0d50: 72 65 61 6d 3f 20 73 74 72 6d 29 29 20 28 65 72 ream? strm)) (er
0d60: 72 6f 72 20 27 73 74 72 65 61 6d 2d 3e 6c 69 73 ror 'stream->lis
0d70: 74 20 22 6e 6f 6e 2d 73 74 72 65 61 6d 20 61 72 t "non-stream ar
0d80: 67 75 6d 65 6e 74 22 29 29 0a 20 20 20 20 20 20 gument")).
0d90: 20 20 20 20 20 20 28 28 61 6e 64 20 6e 20 28 6e ((and n (n
0da0: 6f 74 20 28 69 6e 74 65 67 65 72 3f 20 6e 29 29 ot (integer? n))
0db0: 29 20 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d ) (error 'stream
0dc0: 2d 3e 6c 69 73 74 20 22 6e 6f 6e 2d 69 6e 74 65 ->list "non-inte
0dd0: 67 65 72 20 63 6f 75 6e 74 22 29 29 0a 20 20 20 ger count")).
0de0: 20 20 20 20 20 20 20 20 20 28 28 61 6e 64 20 6e ((and n
0df0: 20 28 6e 65 67 61 74 69 76 65 3f 20 6e 29 29 20 (negative? n))
0e00: 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d 2d 3e (error 'stream->
0e10: 6c 69 73 74 20 22 6e 65 67 61 74 69 76 65 20 63 list "negative c
0e20: 6f 75 6e 74 22 29 29 0a 20 20 20 20 20 20 20 20 ount")).
0e30: 20 20 20 20 28 65 6c 73 65 20 28 6c 65 74 20 6c (else (let l
0e40: 6f 6f 70 20 28 28 6e 20 28 69 66 20 6e 20 6e 20 oop ((n (if n n
0e50: 2d 31 29 29 20 28 73 74 72 6d 20 73 74 72 6d 29 -1)) (strm strm)
0e60: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0e70: 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 7a (if (or (z
0e80: 65 72 6f 3f 20 6e 29 20 28 73 74 72 65 61 6d 2d ero? n) (stream-
0e90: 6e 75 6c 6c 3f 20 73 74 72 6d 29 29 0a 20 20 20 null? strm)).
0ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0eb0: 20 20 20 20 20 27 28 29 0a 20 20 20 20 20 20 20 '().
0ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ed0: 20 28 63 6f 6e 73 20 28 73 74 72 65 61 6d 2d 63 (cons (stream-c
0ee0: 61 72 20 73 74 72 6d 29 20 28 6c 6f 6f 70 20 28 ar strm) (loop (
0ef0: 2d 20 6e 20 31 29 20 28 73 74 72 65 61 6d 2d 63 - n 1) (stream-c
0f00: 64 72 20 73 74 72 6d 29 29 29 29 29 29 29 29 29 dr strm)))))))))
0f10: 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 73 74 72 .. (define (str
0f20: 65 61 6d 2d 61 70 70 65 6e 64 20 2e 20 73 74 72 eam-append . str
0f30: 6d 73 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 ms). (define
0f40: 73 74 72 65 61 6d 2d 61 70 70 65 6e 64 0a 20 20 stream-append.
0f50: 20 20 20 20 28 73 74 72 65 61 6d 2d 6c 61 6d 62 (stream-lamb
0f60: 64 61 20 28 73 74 72 6d 73 29 0a 20 20 20 20 20 da (strms).
0f70: 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f (cond ((null?
0f80: 20 28 63 64 72 20 73 74 72 6d 73 29 29 20 28 63 (cdr strms)) (c
0f90: 61 72 20 73 74 72 6d 73 29 29 0a 20 20 20 20 20 ar strms)).
0fa0: 20 20 20 20 20 20 20 20 20 28 28 73 74 72 65 61 ((strea
0fb0: 6d 2d 6e 75 6c 6c 3f 20 28 63 61 72 20 73 74 72 m-null? (car str
0fc0: 6d 73 29 29 20 28 73 74 72 65 61 6d 2d 61 70 70 ms)) (stream-app
0fd0: 65 6e 64 20 28 63 64 72 20 73 74 72 6d 73 29 29 end (cdr strms))
0fe0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0ff0: 28 65 6c 73 65 20 28 73 74 72 65 61 6d 2d 63 6f (else (stream-co
1000: 6e 73 20 28 73 74 72 65 61 6d 2d 63 61 72 20 28 ns (stream-car (
1010: 63 61 72 20 73 74 72 6d 73 29 29 0a 20 20 20 20 car strms)).
1020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1030: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
1040: 72 65 61 6d 2d 61 70 70 65 6e 64 20 28 63 6f 6e ream-append (con
1050: 73 20 28 73 74 72 65 61 6d 2d 63 64 72 20 28 63 s (stream-cdr (c
1060: 61 72 20 73 74 72 6d 73 29 29 20 28 63 64 72 20 ar strms)) (cdr
1070: 73 74 72 6d 73 29 29 29 29 29 29 29 29 0a 20 20 strms)))))))).
1080: 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 (cond ((null?
1090: 73 74 72 6d 73 29 20 73 74 72 65 61 6d 2d 6e 75 strms) stream-nu
10a0: 6c 6c 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 ll). ((
10b0: 65 78 69 73 74 73 20 28 6c 61 6d 62 64 61 20 28 exists (lambda (
10c0: 78 29 20 28 6e 6f 74 20 28 73 74 72 65 61 6d 3f x) (not (stream?
10d0: 20 78 29 29 29 20 73 74 72 6d 73 29 0a 20 20 20 x))) strms).
10e0: 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 (error
10f0: 27 73 74 72 65 61 6d 2d 61 70 70 65 6e 64 20 22 'stream-append "
1100: 6e 6f 6e 2d 73 74 72 65 61 6d 20 61 72 67 75 6d non-stream argum
1110: 65 6e 74 22 29 29 0a 20 20 20 20 20 20 20 20 20 ent")).
1120: 20 28 65 6c 73 65 20 28 73 74 72 65 61 6d 2d 61 (else (stream-a
1130: 70 70 65 6e 64 20 73 74 72 6d 73 29 29 29 29 0a ppend strms)))).
1140: 0a 20 20 28 64 65 66 69 6e 65 20 28 73 74 72 65 . (define (stre
1150: 61 6d 2d 63 6f 6e 63 61 74 20 73 74 72 6d 73 29 am-concat strms)
1160: 0a 20 20 20 20 28 64 65 66 69 6e 65 20 73 74 72 . (define str
1170: 65 61 6d 2d 63 6f 6e 63 61 74 0a 20 20 20 20 20 eam-concat.
1180: 20 28 73 74 72 65 61 6d 2d 6c 61 6d 62 64 61 20 (stream-lambda
1190: 28 73 74 72 6d 73 29 0a 20 20 20 20 20 20 20 20 (strms).
11a0: 28 63 6f 6e 64 20 28 28 73 74 72 65 61 6d 2d 6e (cond ((stream-n
11b0: 75 6c 6c 3f 20 73 74 72 6d 73 29 20 73 74 72 65 ull? strms) stre
11c0: 61 6d 2d 6e 75 6c 6c 29 0a 20 20 20 20 20 20 20 am-null).
11d0: 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 73 74 ((not (st
11e0: 72 65 61 6d 3f 20 28 73 74 72 65 61 6d 2d 63 61 ream? (stream-ca
11f0: 72 20 73 74 72 6d 73 29 29 29 0a 20 20 20 20 20 r strms))).
1200: 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f (erro
1210: 72 20 27 73 74 72 65 61 6d 2d 63 6f 6e 63 61 74 r 'stream-concat
1220: 20 22 6e 6f 6e 2d 73 74 72 65 61 6d 20 6f 62 6a "non-stream obj
1230: 65 63 74 20 69 6e 20 69 6e 70 75 74 20 73 74 72 ect in input str
1240: 65 61 6d 22 29 29 0a 20 20 20 20 20 20 20 20 20 eam")).
1250: 20 20 20 20 20 28 28 73 74 72 65 61 6d 2d 6e 75 ((stream-nu
1260: 6c 6c 3f 20 28 73 74 72 65 61 6d 2d 63 61 72 20 ll? (stream-car
1270: 73 74 72 6d 73 29 29 0a 20 20 20 20 20 20 20 20 strms)).
1280: 20 20 20 20 20 20 20 20 28 73 74 72 65 61 6d 2d (stream-
1290: 63 6f 6e 63 61 74 20 28 73 74 72 65 61 6d 2d 63 concat (stream-c
12a0: 64 72 20 73 74 72 6d 73 29 29 29 0a 20 20 20 20 dr strms))).
12b0: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
12c0: 28 73 74 72 65 61 6d 2d 63 6f 6e 73 0a 20 20 20 (stream-cons.
12d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12e0: 20 20 20 28 73 74 72 65 61 6d 2d 63 61 72 20 28 (stream-car (
12f0: 73 74 72 65 61 6d 2d 63 61 72 20 73 74 72 6d 73 stream-car strms
1300: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1310: 20 20 20 20 20 20 20 20 20 28 73 74 72 65 61 6d (stream
1320: 2d 63 6f 6e 63 61 74 0a 20 20 20 20 20 20 20 20 -concat.
1330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1340: 28 73 74 72 65 61 6d 2d 63 6f 6e 73 20 28 73 74 (stream-cons (st
1350: 72 65 61 6d 2d 63 64 72 20 28 73 74 72 65 61 6d ream-cdr (stream
1360: 2d 63 61 72 20 73 74 72 6d 73 29 29 20 28 73 74 -car strms)) (st
1370: 72 65 61 6d 2d 63 64 72 20 73 74 72 6d 73 29 29 ream-cdr strms))
1380: 29 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 )))))). (if (
1390: 6e 6f 74 20 28 73 74 72 65 61 6d 3f 20 73 74 72 not (stream? str
13a0: 6d 73 29 29 0a 20 20 20 20 20 20 20 20 28 65 72 ms)). (er
13b0: 72 6f 72 20 27 73 74 72 65 61 6d 2d 63 6f 6e 63 ror 'stream-conc
13c0: 61 74 20 22 6e 6f 6e 2d 73 74 72 65 61 6d 20 61 at "non-stream a
13d0: 72 67 75 6d 65 6e 74 22 29 0a 20 20 20 20 20 20 rgument").
13e0: 20 20 28 73 74 72 65 61 6d 2d 63 6f 6e 63 61 74 (stream-concat
13f0: 20 73 74 72 6d 73 29 29 29 0a 0a 20 20 28 64 65 strms))).. (de
1400: 66 69 6e 65 20 73 74 72 65 61 6d 2d 63 6f 6e 73 fine stream-cons
1410: 74 61 6e 74 0a 20 20 20 20 28 73 74 72 65 61 6d tant. (stream
1420: 2d 6c 61 6d 62 64 61 20 6f 62 6a 73 0a 20 20 20 -lambda objs.
1430: 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f (cond ((null?
1440: 20 6f 62 6a 73 29 20 73 74 72 65 61 6d 2d 6e 75 objs) stream-nu
1450: 6c 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ll).
1460: 28 28 6e 75 6c 6c 3f 20 28 63 64 72 20 6f 62 6a ((null? (cdr obj
1470: 73 29 29 20 28 73 74 72 65 61 6d 2d 63 6f 6e 73 s)) (stream-cons
1480: 20 28 63 61 72 20 6f 62 6a 73 29 20 28 73 74 72 (car objs) (str
1490: 65 61 6d 2d 63 6f 6e 73 74 61 6e 74 20 28 63 61 eam-constant (ca
14a0: 72 20 6f 62 6a 73 29 29 29 29 0a 20 20 20 20 20 r objs)))).
14b0: 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 73 74 (else (st
14c0: 72 65 61 6d 2d 63 6f 6e 73 20 28 63 61 72 20 6f ream-cons (car o
14d0: 62 6a 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 bjs).
14e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14f0: 20 20 20 20 28 61 70 70 6c 79 20 73 74 72 65 61 (apply strea
1500: 6d 2d 63 6f 6e 73 74 61 6e 74 20 28 61 70 70 65 m-constant (appe
1510: 6e 64 20 28 63 64 72 20 6f 62 6a 73 29 20 28 6c nd (cdr objs) (l
1520: 69 73 74 20 28 63 61 72 20 6f 62 6a 73 29 29 29 ist (car objs)))
1530: 29 29 29 29 29 29 0a 0a 20 20 28 64 65 66 69 6e )))))).. (defin
1540: 65 20 28 73 74 72 65 61 6d 2d 64 72 6f 70 20 6e e (stream-drop n
1550: 20 73 74 72 6d 29 0a 20 20 20 20 28 64 65 66 69 strm). (defi
1560: 6e 65 20 73 74 72 65 61 6d 2d 64 72 6f 70 0a 20 ne stream-drop.
1570: 20 20 20 20 20 28 73 74 72 65 61 6d 2d 6c 61 6d (stream-lam
1580: 62 64 61 20 28 6e 20 73 74 72 6d 29 0a 20 20 20 bda (n strm).
1590: 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 7a 65 (if (or (ze
15a0: 72 6f 3f 20 6e 29 20 28 73 74 72 65 61 6d 2d 6e ro? n) (stream-n
15b0: 75 6c 6c 3f 20 73 74 72 6d 29 29 0a 20 20 20 20 ull? strm)).
15c0: 20 20 20 20 20 20 20 20 73 74 72 6d 0a 20 20 20 strm.
15d0: 20 20 20 20 20 20 20 20 20 28 73 74 72 65 61 6d (stream
15e0: 2d 64 72 6f 70 20 28 2d 20 6e 20 31 29 20 28 73 -drop (- n 1) (s
15f0: 74 72 65 61 6d 2d 63 64 72 20 73 74 72 6d 29 29 tream-cdr strm))
1600: 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 20 28 28 ))). (cond ((
1610: 6e 6f 74 20 28 69 6e 74 65 67 65 72 3f 20 6e 29 not (integer? n)
1620: 29 20 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d ) (error 'stream
1630: 2d 64 72 6f 70 20 22 6e 6f 6e 2d 69 6e 74 65 67 -drop "non-integ
1640: 65 72 20 61 72 67 75 6d 65 6e 74 22 29 29 0a 20 er argument")).
1650: 20 20 20 20 20 20 20 20 20 28 28 6e 65 67 61 74 ((negat
1660: 69 76 65 3f 20 6e 29 20 28 65 72 72 6f 72 20 27 ive? n) (error '
1670: 73 74 72 65 61 6d 2d 64 72 6f 70 20 22 6e 65 67 stream-drop "neg
1680: 61 74 69 76 65 20 61 72 67 75 6d 65 6e 74 22 29 ative argument")
1690: 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f ). ((no
16a0: 74 20 28 73 74 72 65 61 6d 3f 20 73 74 72 6d 29 t (stream? strm)
16b0: 29 20 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d ) (error 'stream
16c0: 2d 64 72 6f 70 20 22 6e 6f 6e 2d 73 74 72 65 61 -drop "non-strea
16d0: 6d 20 61 72 67 75 6d 65 6e 74 22 29 29 0a 20 20 m argument")).
16e0: 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 73 (else (s
16f0: 74 72 65 61 6d 2d 64 72 6f 70 20 6e 20 73 74 72 tream-drop n str
1700: 6d 29 29 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 m)))).. (define
1710: 20 28 73 74 72 65 61 6d 2d 64 72 6f 70 2d 77 68 (stream-drop-wh
1720: 69 6c 65 20 70 72 65 64 3f 20 73 74 72 6d 29 0a ile pred? strm).
1730: 20 20 20 20 28 64 65 66 69 6e 65 20 73 74 72 65 (define stre
1740: 61 6d 2d 64 72 6f 70 2d 77 68 69 6c 65 0a 20 20 am-drop-while.
1750: 20 20 20 20 28 73 74 72 65 61 6d 2d 6c 61 6d 62 (stream-lamb
1760: 64 61 20 28 73 74 72 6d 29 0a 20 20 20 20 20 20 da (strm).
1770: 20 20 28 69 66 20 28 61 6e 64 20 28 73 74 72 65 (if (and (stre
1780: 61 6d 2d 70 61 69 72 3f 20 73 74 72 6d 29 20 28 am-pair? strm) (
1790: 70 72 65 64 3f 20 28 73 74 72 65 61 6d 2d 63 61 pred? (stream-ca
17a0: 72 20 73 74 72 6d 29 29 29 0a 20 20 20 20 20 20 r strm))).
17b0: 20 20 20 20 20 20 28 73 74 72 65 61 6d 2d 64 72 (stream-dr
17c0: 6f 70 2d 77 68 69 6c 65 20 28 73 74 72 65 61 6d op-while (stream
17d0: 2d 63 64 72 20 73 74 72 6d 29 29 0a 20 20 20 20 -cdr strm)).
17e0: 20 20 20 20 20 20 20 20 73 74 72 6d 29 29 29 0a strm))).
17f0: 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 6f 74 20 (cond ((not
1800: 28 70 72 6f 63 65 64 75 72 65 3f 20 70 72 65 64 (procedure? pred
1810: 3f 29 29 20 28 65 72 72 6f 72 20 27 73 74 72 65 ?)) (error 'stre
1820: 61 6d 2d 64 72 6f 70 2d 77 68 69 6c 65 20 22 6e am-drop-while "n
1830: 6f 6e 2d 70 72 6f 63 65 64 75 72 61 6c 20 61 72 on-procedural ar
1840: 67 75 6d 65 6e 74 22 29 29 0a 20 20 20 20 20 20 gument")).
1850: 20 20 20 20 28 28 6e 6f 74 20 28 73 74 72 65 61 ((not (strea
1860: 6d 3f 20 73 74 72 6d 29 29 20 28 65 72 72 6f 72 m? strm)) (error
1870: 20 27 73 74 72 65 61 6d 2d 64 72 6f 70 2d 77 68 'stream-drop-wh
1880: 69 6c 65 20 22 6e 6f 6e 2d 73 74 72 65 61 6d 20 ile "non-stream
1890: 61 72 67 75 6d 65 6e 74 22 29 29 0a 20 20 20 20 argument")).
18a0: 20 20 20 20 20 20 28 65 6c 73 65 20 28 73 74 72 (else (str
18b0: 65 61 6d 2d 64 72 6f 70 2d 77 68 69 6c 65 20 73 eam-drop-while s
18c0: 74 72 6d 29 29 29 29 0a 0a 20 20 28 64 65 66 69 trm)))).. (defi
18d0: 6e 65 20 28 73 74 72 65 61 6d 2d 66 69 6c 74 65 ne (stream-filte
18e0: 72 20 70 72 65 64 3f 20 73 74 72 6d 29 0a 20 20 r pred? strm).
18f0: 20 20 28 64 65 66 69 6e 65 20 73 74 72 65 61 6d (define stream
1900: 2d 66 69 6c 74 65 72 0a 20 20 20 20 20 20 28 73 -filter. (s
1910: 74 72 65 61 6d 2d 6c 61 6d 62 64 61 20 28 73 74 tream-lambda (st
1920: 72 6d 29 0a 20 20 20 20 20 20 20 20 28 63 6f 6e rm). (con
1930: 64 20 28 28 73 74 72 65 61 6d 2d 6e 75 6c 6c 3f d ((stream-null?
1940: 20 73 74 72 6d 29 20 73 74 72 65 61 6d 2d 6e 75 strm) stream-nu
1950: 6c 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ll).
1960: 20 20 28 28 70 72 65 64 3f 20 28 73 74 72 65 61 ((pred? (strea
1970: 6d 2d 63 61 72 20 73 74 72 6d 29 29 0a 20 20 20 m-car strm)).
1980: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
1990: 72 65 61 6d 2d 63 6f 6e 73 20 28 73 74 72 65 61 ream-cons (strea
19a0: 6d 2d 63 61 72 20 73 74 72 6d 29 20 28 73 74 72 m-car strm) (str
19b0: 65 61 6d 2d 66 69 6c 74 65 72 20 28 73 74 72 65 eam-filter (stre
19c0: 61 6d 2d 63 64 72 20 73 74 72 6d 29 29 29 29 0a am-cdr strm)))).
19d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
19e0: 6c 73 65 20 28 73 74 72 65 61 6d 2d 66 69 6c 74 lse (stream-filt
19f0: 65 72 20 28 73 74 72 65 61 6d 2d 63 64 72 20 73 er (stream-cdr s
1a00: 74 72 6d 29 29 29 29 29 29 0a 20 20 20 20 28 63 trm)))))). (c
1a10: 6f 6e 64 20 28 28 6e 6f 74 20 28 70 72 6f 63 65 ond ((not (proce
1a20: 64 75 72 65 3f 20 70 72 65 64 3f 29 29 20 28 65 dure? pred?)) (e
1a30: 72 72 6f 72 20 27 73 74 72 65 61 6d 2d 66 69 6c rror 'stream-fil
1a40: 74 65 72 20 22 6e 6f 6e 2d 70 72 6f 63 65 64 75 ter "non-procedu
1a50: 72 61 6c 20 61 72 67 75 6d 65 6e 74 22 29 29 0a ral argument")).
1a60: 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f 74 20 ((not
1a70: 28 73 74 72 65 61 6d 3f 20 73 74 72 6d 29 29 20 (stream? strm))
1a80: 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d 2d 66 (error 'stream-f
1a90: 69 6c 74 65 72 20 22 6e 6f 6e 2d 73 74 72 65 61 ilter "non-strea
1aa0: 6d 20 61 72 67 75 6d 65 6e 74 22 29 29 0a 20 20 m argument")).
1ab0: 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 73 (else (s
1ac0: 74 72 65 61 6d 2d 66 69 6c 74 65 72 20 73 74 72 tream-filter str
1ad0: 6d 29 29 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 m)))).. (define
1ae0: 20 28 73 74 72 65 61 6d 2d 66 6f 6c 64 20 70 72 (stream-fold pr
1af0: 6f 63 20 62 61 73 65 20 73 74 72 6d 29 0a 20 20 oc base strm).
1b00: 20 20 28 63 6f 6e 64 20 28 28 6e 6f 74 20 28 70 (cond ((not (p
1b10: 72 6f 63 65 64 75 72 65 3f 20 70 72 6f 63 29 29 rocedure? proc))
1b20: 20 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d 2d (error 'stream-
1b30: 66 6f 6c 64 20 22 6e 6f 6e 2d 70 72 6f 63 65 64 fold "non-proced
1b40: 75 72 61 6c 20 61 72 67 75 6d 65 6e 74 22 29 29 ural argument"))
1b50: 0a 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f 74 . ((not
1b60: 20 28 73 74 72 65 61 6d 3f 20 73 74 72 6d 29 29 (stream? strm))
1b70: 20 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d 2d (error 'stream-
1b80: 66 6f 6c 64 20 22 6e 6f 6e 2d 73 74 72 65 61 6d fold "non-stream
1b90: 20 61 72 67 75 6d 65 6e 74 22 29 29 0a 20 20 20 argument")).
1ba0: 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 6c 65 (else (le
1bb0: 74 20 6c 6f 6f 70 20 28 28 62 61 73 65 20 62 61 t loop ((base ba
1bc0: 73 65 29 20 28 73 74 72 6d 20 73 74 72 6d 29 29 se) (strm strm))
1bd0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1be0: 20 20 20 28 69 66 20 28 73 74 72 65 61 6d 2d 6e (if (stream-n
1bf0: 75 6c 6c 3f 20 73 74 72 6d 29 0a 20 20 20 20 20 ull? strm).
1c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c10: 20 62 61 73 65 0a 20 20 20 20 20 20 20 20 20 20 base.
1c20: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
1c30: 70 20 28 70 72 6f 63 20 62 61 73 65 20 28 73 74 p (proc base (st
1c40: 72 65 61 6d 2d 63 61 72 20 73 74 72 6d 29 29 20 ream-car strm))
1c50: 28 73 74 72 65 61 6d 2d 63 64 72 20 73 74 72 6d (stream-cdr strm
1c60: 29 29 29 29 29 29 29 0a 0a 20 20 28 64 65 66 69 ))))))).. (defi
1c70: 6e 65 20 28 73 74 72 65 61 6d 2d 66 6f 72 2d 65 ne (stream-for-e
1c80: 61 63 68 20 70 72 6f 63 20 2e 20 73 74 72 6d 73 ach proc . strms
1c90: 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 28 73 ). (define (s
1ca0: 74 72 65 61 6d 2d 66 6f 72 2d 65 61 63 68 20 73 tream-for-each s
1cb0: 74 72 6d 73 29 0a 20 20 20 20 20 20 28 69 66 20 trms). (if
1cc0: 28 6e 6f 74 20 28 65 78 69 73 74 73 20 73 74 72 (not (exists str
1cd0: 65 61 6d 2d 6e 75 6c 6c 3f 20 73 74 72 6d 73 29 eam-null? strms)
1ce0: 29 0a 20 20 20 20 20 20 20 20 20 20 28 62 65 67 ). (beg
1cf0: 69 6e 20 28 61 70 70 6c 79 20 70 72 6f 63 20 28 in (apply proc (
1d00: 6d 61 70 20 73 74 72 65 61 6d 2d 63 61 72 20 73 map stream-car s
1d10: 74 72 6d 73 29 29 0a 20 20 20 20 20 20 20 20 20 trms)).
1d20: 20 20 20 20 20 20 20 20 28 73 74 72 65 61 6d 2d (stream-
1d30: 66 6f 72 2d 65 61 63 68 20 28 6d 61 70 20 73 74 for-each (map st
1d40: 72 65 61 6d 2d 63 64 72 20 73 74 72 6d 73 29 29 ream-cdr strms))
1d50: 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 20 28 28 ))). (cond ((
1d60: 6e 6f 74 20 28 70 72 6f 63 65 64 75 72 65 3f 20 not (procedure?
1d70: 70 72 6f 63 29 29 20 28 65 72 72 6f 72 20 27 73 proc)) (error 's
1d80: 74 72 65 61 6d 2d 66 6f 72 2d 65 61 63 68 20 22 tream-for-each "
1d90: 6e 6f 6e 2d 70 72 6f 63 65 64 75 72 61 6c 20 61 non-procedural a
1da0: 72 67 75 6d 65 6e 74 22 29 29 0a 20 20 20 20 20 rgument")).
1db0: 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 73 74 72 ((null? str
1dc0: 6d 73 29 20 28 65 72 72 6f 72 20 27 73 74 72 65 ms) (error 'stre
1dd0: 61 6d 2d 66 6f 72 2d 65 61 63 68 20 22 6e 6f 20 am-for-each "no
1de0: 73 74 72 65 61 6d 20 61 72 67 75 6d 65 6e 74 73 stream arguments
1df0: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 ")). ((
1e00: 65 78 69 73 74 73 20 28 6c 61 6d 62 64 61 20 28 exists (lambda (
1e10: 78 29 20 28 6e 6f 74 20 28 73 74 72 65 61 6d 3f x) (not (stream?
1e20: 20 78 29 29 29 20 73 74 72 6d 73 29 0a 20 20 20 x))) strms).
1e30: 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 (error
1e40: 27 73 74 72 65 61 6d 2d 66 6f 72 2d 65 61 63 68 'stream-for-each
1e50: 20 22 6e 6f 6e 2d 73 74 72 65 61 6d 20 61 72 67 "non-stream arg
1e60: 75 6d 65 6e 74 22 29 29 0a 20 20 20 20 20 20 20 ument")).
1e70: 20 20 20 28 65 6c 73 65 20 28 73 74 72 65 61 6d (else (stream
1e80: 2d 66 6f 72 2d 65 61 63 68 20 73 74 72 6d 73 29 -for-each strms)
1e90: 29 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 ))).. (define (
1ea0: 73 74 72 65 61 6d 2d 66 72 6f 6d 20 66 69 72 73 stream-from firs
1eb0: 74 20 2e 20 73 74 65 70 29 0a 20 20 20 20 28 64 t . step). (d
1ec0: 65 66 69 6e 65 20 73 74 72 65 61 6d 2d 66 72 6f efine stream-fro
1ed0: 6d 0a 20 20 20 20 20 20 28 73 74 72 65 61 6d 2d m. (stream-
1ee0: 6c 61 6d 62 64 61 20 28 66 69 72 73 74 20 64 65 lambda (first de
1ef0: 6c 74 61 29 0a 20 20 20 20 20 20 20 20 28 73 74 lta). (st
1f00: 72 65 61 6d 2d 63 6f 6e 73 20 66 69 72 73 74 20 ream-cons first
1f10: 28 73 74 72 65 61 6d 2d 66 72 6f 6d 20 28 2b 20 (stream-from (+
1f20: 66 69 72 73 74 20 64 65 6c 74 61 29 20 64 65 6c first delta) del
1f30: 74 61 29 29 29 29 0a 20 20 20 20 28 6c 65 74 20 ta)))). (let
1f40: 28 28 64 65 6c 74 61 20 28 69 66 20 28 6e 75 6c ((delta (if (nul
1f50: 6c 3f 20 73 74 65 70 29 20 31 20 28 63 61 72 20 l? step) 1 (car
1f60: 73 74 65 70 29 29 29 29 0a 20 20 20 20 20 20 28 step)))). (
1f70: 63 6f 6e 64 20 28 28 6e 6f 74 20 28 6e 75 6d 62 cond ((not (numb
1f80: 65 72 3f 20 66 69 72 73 74 29 29 20 28 65 72 72 er? first)) (err
1f90: 6f 72 20 27 73 74 72 65 61 6d 2d 66 72 6f 6d 20 or 'stream-from
1fa0: 22 6e 6f 6e 2d 6e 75 6d 65 72 69 63 20 73 74 61 "non-numeric sta
1fb0: 72 74 69 6e 67 20 6e 75 6d 62 65 72 22 29 29 0a rting number")).
1fc0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f ((no
1fd0: 74 20 28 6e 75 6d 62 65 72 3f 20 64 65 6c 74 61 t (number? delta
1fe0: 29 29 20 28 65 72 72 6f 72 20 27 73 74 72 65 61 )) (error 'strea
1ff0: 6d 2d 66 72 6f 6d 20 22 6e 6f 6e 2d 6e 75 6d 65 m-from "non-nume
2000: 72 69 63 20 73 74 65 70 20 73 69 7a 65 22 29 29 ric step size"))
2010: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c . (el
2020: 73 65 20 28 73 74 72 65 61 6d 2d 66 72 6f 6d 20 se (stream-from
2030: 66 69 72 73 74 20 64 65 6c 74 61 29 29 29 29 29 first delta)))))
2040: 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 73 74 72 .. (define (str
2050: 65 61 6d 2d 69 74 65 72 61 74 65 20 70 72 6f 63 eam-iterate proc
2060: 20 62 61 73 65 29 0a 20 20 20 20 28 64 65 66 69 base). (defi
2070: 6e 65 20 73 74 72 65 61 6d 2d 69 74 65 72 61 74 ne stream-iterat
2080: 65 0a 20 20 20 20 20 20 28 73 74 72 65 61 6d 2d e. (stream-
2090: 6c 61 6d 62 64 61 20 28 62 61 73 65 29 0a 20 20 lambda (base).
20a0: 20 20 20 20 20 20 28 73 74 72 65 61 6d 2d 63 6f (stream-co
20b0: 6e 73 20 62 61 73 65 20 28 73 74 72 65 61 6d 2d ns base (stream-
20c0: 69 74 65 72 61 74 65 20 28 70 72 6f 63 20 62 61 iterate (proc ba
20d0: 73 65 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 se))))). (if
20e0: 28 6e 6f 74 20 28 70 72 6f 63 65 64 75 72 65 3f (not (procedure?
20f0: 20 70 72 6f 63 29 29 0a 20 20 20 20 20 20 20 20 proc)).
2100: 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d 2d 69 (error 'stream-i
2110: 74 65 72 61 74 65 20 22 6e 6f 6e 2d 70 72 6f 63 terate "non-proc
2120: 65 64 75 72 61 6c 20 61 72 67 75 6d 65 6e 74 22 edural argument"
2130: 29 0a 20 20 20 20 20 20 20 20 28 73 74 72 65 61 ). (strea
2140: 6d 2d 69 74 65 72 61 74 65 20 62 61 73 65 29 29 m-iterate base))
2150: 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 73 74 ).. (define (st
2160: 72 65 61 6d 2d 6c 65 6e 67 74 68 20 73 74 72 6d ream-length strm
2170: 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ). (if (not (
2180: 73 74 72 65 61 6d 3f 20 73 74 72 6d 29 29 0a 20 stream? strm)).
2190: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 27 73 (error 's
21a0: 74 72 65 61 6d 2d 6c 65 6e 67 74 68 20 22 6e 6f tream-length "no
21b0: 6e 2d 73 74 72 65 61 6d 20 61 72 67 75 6d 65 6e n-stream argumen
21c0: 74 22 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 t"). (let
21d0: 20 6c 6f 6f 70 20 28 28 6c 65 6e 20 30 29 20 28 loop ((len 0) (
21e0: 73 74 72 6d 20 73 74 72 6d 29 29 0a 20 20 20 20 strm strm)).
21f0: 20 20 20 20 20 20 28 69 66 20 28 73 74 72 65 61 (if (strea
2200: 6d 2d 6e 75 6c 6c 3f 20 73 74 72 6d 29 0a 20 20 m-null? strm).
2210: 20 20 20 20 20 20 20 20 20 20 20 20 6c 65 6e 0a len.
2220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
2230: 6f 6f 70 20 28 2b 20 6c 65 6e 20 31 29 20 28 73 oop (+ len 1) (s
2240: 74 72 65 61 6d 2d 63 64 72 20 73 74 72 6d 29 29 tream-cdr strm))
2250: 29 29 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 2d )))).. (define-
2260: 73 79 6e 74 61 78 20 73 74 72 65 61 6d 2d 6c 65 syntax stream-le
2270: 74 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 72 75 t. (syntax-ru
2280: 6c 65 73 20 28 29 0a 20 20 20 20 20 20 28 28 73 les (). ((s
2290: 74 72 65 61 6d 2d 6c 65 74 20 74 61 67 20 28 28 tream-let tag ((
22a0: 6e 61 6d 65 20 76 61 6c 29 20 2e 2e 2e 29 20 62 name val) ...) b
22b0: 6f 64 79 31 20 62 6f 64 79 32 20 2e 2e 2e 29 0a ody1 body2 ...).
22c0: 20 20 20 20 20 20 20 28 28 6c 65 74 72 65 63 20 ((letrec
22d0: 28 28 74 61 67 20 28 73 74 72 65 61 6d 2d 6c 61 ((tag (stream-la
22e0: 6d 62 64 61 20 28 6e 61 6d 65 20 2e 2e 2e 29 20 mbda (name ...)
22f0: 62 6f 64 79 31 20 62 6f 64 79 32 20 2e 2e 2e 29 body1 body2 ...)
2300: 29 29 20 74 61 67 29 20 76 61 6c 20 2e 2e 2e 29 )) tag) val ...)
2310: 29 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 ))).. (define (
2320: 73 74 72 65 61 6d 2d 6d 61 70 20 70 72 6f 63 20 stream-map proc
2330: 2e 20 73 74 72 6d 73 29 0a 20 20 20 20 28 64 65 . strms). (de
2340: 66 69 6e 65 20 73 74 72 65 61 6d 2d 6d 61 70 0a fine stream-map.
2350: 20 20 20 20 20 20 28 73 74 72 65 61 6d 2d 6c 61 (stream-la
2360: 6d 62 64 61 20 28 73 74 72 6d 73 29 0a 20 20 20 mbda (strms).
2370: 20 20 20 20 20 28 69 66 20 28 65 78 69 73 74 73 (if (exists
2380: 20 73 74 72 65 61 6d 2d 6e 75 6c 6c 3f 20 73 74 stream-null? st
2390: 72 6d 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 rms).
23a0: 20 73 74 72 65 61 6d 2d 6e 75 6c 6c 0a 20 20 20 stream-null.
23b0: 20 20 20 20 20 20 20 20 20 28 73 74 72 65 61 6d (stream
23c0: 2d 63 6f 6e 73 20 28 61 70 70 6c 79 20 70 72 6f -cons (apply pro
23d0: 63 20 28 6d 61 70 20 73 74 72 65 61 6d 2d 63 61 c (map stream-ca
23e0: 72 20 73 74 72 6d 73 29 29 0a 20 20 20 20 20 20 r strms)).
23f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2400: 20 20 20 28 73 74 72 65 61 6d 2d 6d 61 70 20 28 (stream-map (
2410: 6d 61 70 20 73 74 72 65 61 6d 2d 63 64 72 20 73 map stream-cdr s
2420: 74 72 6d 73 29 29 29 29 29 29 0a 20 20 20 20 28 trms)))))). (
2430: 63 6f 6e 64 20 28 28 6e 6f 74 20 28 70 72 6f 63 cond ((not (proc
2440: 65 64 75 72 65 3f 20 70 72 6f 63 29 29 20 28 65 edure? proc)) (e
2450: 72 72 6f 72 20 27 73 74 72 65 61 6d 2d 6d 61 70 rror 'stream-map
2460: 20 22 6e 6f 6e 2d 70 72 6f 63 65 64 75 72 61 6c "non-procedural
2470: 20 61 72 67 75 6d 65 6e 74 22 29 29 0a 20 20 20 argument")).
2480: 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 73 ((null? s
2490: 74 72 6d 73 29 20 28 65 72 72 6f 72 20 27 73 74 trms) (error 'st
24a0: 72 65 61 6d 2d 6d 61 70 20 22 6e 6f 20 73 74 72 ream-map "no str
24b0: 65 61 6d 20 61 72 67 75 6d 65 6e 74 73 22 29 29 eam arguments"))
24c0: 0a 20 20 20 20 20 20 20 20 20 20 28 28 65 78 69 . ((exi
24d0: 73 74 73 20 28 6c 61 6d 62 64 61 20 28 78 29 20 sts (lambda (x)
24e0: 28 6e 6f 74 20 28 73 74 72 65 61 6d 3f 20 78 29 (not (stream? x)
24f0: 29 29 20 73 74 72 6d 73 29 0a 20 20 20 20 20 20 )) strms).
2500: 20 20 20 20 20 20 28 65 72 72 6f 72 20 27 73 74 (error 'st
2510: 72 65 61 6d 2d 6d 61 70 20 22 6e 6f 6e 2d 73 74 ream-map "non-st
2520: 72 65 61 6d 20 61 72 67 75 6d 65 6e 74 22 29 29 ream argument"))
2530: 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 . (else
2540: 20 28 73 74 72 65 61 6d 2d 6d 61 70 20 73 74 72 (stream-map str
2550: 6d 73 29 29 29 29 0a 0a 20 20 28 64 65 66 69 6e ms)))).. (defin
2560: 65 2d 73 79 6e 74 61 78 20 73 74 72 65 61 6d 2d e-syntax stream-
2570: 6d 61 74 63 68 0a 20 20 20 20 28 73 79 6e 74 61 match. (synta
2580: 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 20 x-rules ().
2590: 20 28 28 73 74 72 65 61 6d 2d 6d 61 74 63 68 20 ((stream-match
25a0: 73 74 72 6d 2d 65 78 70 72 20 63 6c 61 75 73 65 strm-expr clause
25b0: 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 28 6c ...). (l
25c0: 65 74 20 28 28 73 74 72 6d 20 73 74 72 6d 2d 65 et ((strm strm-e
25d0: 78 70 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 xpr)).
25e0: 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 (cond.
25f0: 20 20 28 28 6e 6f 74 20 28 73 74 72 65 61 6d 3f ((not (stream?
2600: 20 73 74 72 6d 29 29 20 28 65 72 72 6f 72 20 27 strm)) (error '
2610: 73 74 72 65 61 6d 2d 6d 61 74 63 68 20 22 6e 6f stream-match "no
2620: 6e 2d 73 74 72 65 61 6d 20 61 72 67 75 6d 65 6e n-stream argumen
2630: 74 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t")).
2640: 20 28 28 73 74 72 65 61 6d 2d 6d 61 74 63 68 2d ((stream-match-
2650: 74 65 73 74 20 73 74 72 6d 20 63 6c 61 75 73 65 test strm clause
2660: 29 20 3d 3e 20 63 61 72 29 20 2e 2e 2e 0a 20 20 ) => car) ....
2670: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
2680: 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d 2d 6d (error 'stream-m
2690: 61 74 63 68 20 22 70 61 74 74 65 72 6e 20 66 61 atch "pattern fa
26a0: 69 6c 75 72 65 22 29 29 29 29 29 29 29 0a 0a 20 ilure")))))))..
26b0: 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 (define-syntax
26c0: 73 74 72 65 61 6d 2d 6d 61 74 63 68 2d 74 65 73 stream-match-tes
26d0: 74 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 72 75 t. (syntax-ru
26e0: 6c 65 73 20 28 29 0a 20 20 20 20 20 20 28 28 73 les (). ((s
26f0: 74 72 65 61 6d 2d 6d 61 74 63 68 2d 74 65 73 74 tream-match-test
2700: 20 73 74 72 6d 20 28 70 61 74 74 65 72 6e 20 66 strm (pattern f
2710: 65 6e 64 65 72 20 65 78 70 72 29 29 0a 20 20 20 ender expr)).
2720: 20 20 20 20 20 28 73 74 72 65 61 6d 2d 6d 61 74 (stream-mat
2730: 63 68 2d 70 61 74 74 65 72 6e 20 73 74 72 6d 20 ch-pattern strm
2740: 70 61 74 74 65 72 6e 20 28 29 20 28 61 6e 64 20 pattern () (and
2750: 66 65 6e 64 65 72 20 28 6c 69 73 74 20 65 78 70 fender (list exp
2760: 72 29 29 29 29 0a 20 20 20 20 20 20 28 28 73 74 r)))). ((st
2770: 72 65 61 6d 2d 6d 61 74 63 68 2d 74 65 73 74 20 ream-match-test
2780: 73 74 72 6d 20 28 70 61 74 74 65 72 6e 20 65 78 strm (pattern ex
2790: 70 72 29 29 0a 20 20 20 20 20 20 20 20 28 73 74 pr)). (st
27a0: 72 65 61 6d 2d 6d 61 74 63 68 2d 70 61 74 74 65 ream-match-patte
27b0: 72 6e 20 73 74 72 6d 20 70 61 74 74 65 72 6e 20 rn strm pattern
27c0: 28 29 20 28 6c 69 73 74 20 65 78 70 72 29 29 29 () (list expr)))
27d0: 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 2d 73 79 )).. (define-sy
27e0: 6e 74 61 78 20 73 74 72 65 61 6d 2d 6d 61 74 63 ntax stream-matc
27f0: 68 2d 70 61 74 74 65 72 6e 20 0a 20 20 20 20 28 h-pattern . (
2800: 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20 lambda (x).
2810: 20 28 64 65 66 69 6e 65 20 28 77 69 6c 64 63 61 (define (wildca
2820: 72 64 3f 20 78 29 0a 20 20 20 20 20 20 20 20 28 rd? x). (
2830: 61 6e 64 20 28 69 64 65 6e 74 69 66 69 65 72 3f and (identifier?
2840: 20 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 x).
2850: 20 28 66 72 65 65 2d 69 64 65 6e 74 69 66 69 65 (free-identifie
2860: 72 3d 3f 20 78 20 28 73 79 6e 74 61 78 20 5f 29 r=? x (syntax _)
2870: 29 29 29 0a 20 20 20 20 20 20 28 73 79 6e 74 61 ))). (synta
2880: 78 2d 63 61 73 65 20 78 20 28 29 20 0a 20 20 20 x-case x () .
2890: 20 20 20 20 20 28 28 73 74 72 65 61 6d 2d 6d 61 ((stream-ma
28a0: 74 63 68 2d 70 61 74 74 65 72 6e 20 73 74 72 6d tch-pattern strm
28b0: 20 28 29 20 28 62 69 6e 64 69 6e 67 20 2e 2e 2e () (binding ...
28c0: 29 20 62 6f 64 79 29 0a 20 20 20 20 20 20 20 20 ) body).
28d0: 20 20 28 73 79 6e 74 61 78 20 28 61 6e 64 20 28 (syntax (and (
28e0: 73 74 72 65 61 6d 2d 6e 75 6c 6c 3f 20 73 74 72 stream-null? str
28f0: 6d 29 20 28 6c 65 74 20 28 62 69 6e 64 69 6e 67 m) (let (binding
2900: 20 2e 2e 2e 29 20 62 6f 64 79 29 29 29 29 0a 20 ...) body)))).
2910: 20 20 20 20 20 20 20 28 28 73 74 72 65 61 6d 2d ((stream-
2920: 6d 61 74 63 68 2d 70 61 74 74 65 72 6e 20 73 74 match-pattern st
2930: 72 6d 20 28 77 3f 20 2e 20 72 65 73 74 29 20 28 rm (w? . rest) (
2940: 62 69 6e 64 69 6e 67 20 2e 2e 2e 29 20 62 6f 64 binding ...) bod
2950: 79 29 0a 20 20 20 20 20 20 20 20 20 20 28 77 69 y). (wi
2960: 6c 64 63 61 72 64 3f 20 23 27 77 3f 29 20 0a 20 ldcard? #'w?) .
2970: 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 61 78 (syntax
2980: 20 28 61 6e 64 20 28 73 74 72 65 61 6d 2d 70 61 (and (stream-pa
2990: 69 72 3f 20 73 74 72 6d 29 0a 20 20 20 20 20 20 ir? strm).
29a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29b0: 20 28 6c 65 74 20 28 28 73 74 72 6d 20 28 73 74 (let ((strm (st
29c0: 72 65 61 6d 2d 63 64 72 20 73 74 72 6d 29 29 29 ream-cdr strm)))
29d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
29e0: 20 20 20 20 20 20 20 20 20 20 28 73 74 72 65 61 (strea
29f0: 6d 2d 6d 61 74 63 68 2d 70 61 74 74 65 72 6e 20 m-match-pattern
2a00: 73 74 72 6d 20 72 65 73 74 20 28 62 69 6e 64 69 strm rest (bindi
2a10: 6e 67 20 2e 2e 2e 29 20 62 6f 64 79 29 29 29 29 ng ...) body))))
2a20: 29 0a 20 20 20 20 20 20 20 20 28 28 73 74 72 65 ). ((stre
2a30: 61 6d 2d 6d 61 74 63 68 2d 70 61 74 74 65 72 6e am-match-pattern
2a40: 20 73 74 72 6d 20 28 76 61 72 20 2e 20 72 65 73 strm (var . res
2a50: 74 29 20 28 62 69 6e 64 69 6e 67 20 2e 2e 2e 29 t) (binding ...)
2a60: 20 62 6f 64 79 29 0a 20 20 20 20 20 20 20 20 20 body).
2a70: 20 28 73 79 6e 74 61 78 20 28 61 6e 64 20 28 73 (syntax (and (s
2a80: 74 72 65 61 6d 2d 70 61 69 72 3f 20 73 74 72 6d tream-pair? strm
2a90: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2aa0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
2ab0: 74 65 6d 70 20 28 73 74 72 65 61 6d 2d 63 61 72 temp (stream-car
2ac0: 20 73 74 72 6d 29 29 20 28 73 74 72 6d 20 28 73 strm)) (strm (s
2ad0: 74 72 65 61 6d 2d 63 64 72 20 73 74 72 6d 29 29 tream-cdr strm))
2ae0: 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ) .
2af0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 (str
2b00: 65 61 6d 2d 6d 61 74 63 68 2d 70 61 74 74 65 72 eam-match-patter
2b10: 6e 20 73 74 72 6d 20 72 65 73 74 20 28 28 76 61 n strm rest ((va
2b20: 72 20 74 65 6d 70 29 20 62 69 6e 64 69 6e 67 20 r temp) binding
2b30: 2e 2e 2e 29 20 62 6f 64 79 29 29 29 29 29 0a 20 ...) body))))).
2b40: 20 20 20 20 20 20 20 28 28 73 74 72 65 61 6d 2d ((stream-
2b50: 6d 61 74 63 68 2d 70 61 74 74 65 72 6e 20 73 74 match-pattern st
2b60: 72 6d 20 77 3f 20 28 62 69 6e 64 69 6e 67 20 2e rm w? (binding .
2b70: 2e 2e 29 20 62 6f 64 79 29 0a 20 20 20 20 20 20 ..) body).
2b80: 20 20 20 20 28 77 69 6c 64 63 61 72 64 3f 20 23 (wildcard? #
2b90: 27 77 3f 29 0a 20 20 20 20 20 20 20 20 20 20 28 'w?). (
2ba0: 73 79 6e 74 61 78 20 28 6c 65 74 20 28 62 69 6e syntax (let (bin
2bb0: 64 69 6e 67 20 2e 2e 2e 29 20 62 6f 64 79 29 29 ding ...) body))
2bc0: 29 0a 20 20 20 20 20 20 20 20 28 28 73 74 72 65 ). ((stre
2bd0: 61 6d 2d 6d 61 74 63 68 2d 70 61 74 74 65 72 6e am-match-pattern
2be0: 20 73 74 72 6d 20 76 61 72 20 28 62 69 6e 64 69 strm var (bindi
2bf0: 6e 67 20 2e 2e 2e 29 20 62 6f 64 79 29 20 0a 20 ng ...) body) .
2c00: 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 61 78 (syntax
2c10: 20 28 6c 65 74 20 28 28 76 61 72 20 73 74 72 6d (let ((var strm
2c20: 29 20 62 69 6e 64 69 6e 67 20 2e 2e 2e 29 20 62 ) binding ...) b
2c30: 6f 64 79 29 29 29 29 29 29 0a 0a 20 20 28 64 65 ody)))))).. (de
2c40: 66 69 6e 65 2d 73 79 6e 74 61 78 20 73 74 72 65 fine-syntax stre
2c50: 61 6d 2d 6f 66 0a 20 20 20 20 28 73 79 6e 74 61 am-of. (synta
2c60: 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 20 x-rules ().
2c70: 20 28 28 5f 20 65 78 70 72 20 72 65 73 74 20 2e ((_ expr rest .
2c80: 2e 2e 29 0a 20 20 20 20 20 20 20 20 28 73 74 72 ..). (str
2c90: 65 61 6d 2d 6f 66 2d 61 75 78 20 65 78 70 72 20 eam-of-aux expr
2ca0: 73 74 72 65 61 6d 2d 6e 75 6c 6c 20 72 65 73 74 stream-null rest
2cb0: 20 2e 2e 2e 29 29 29 29 0a 0a 20 20 28 64 65 66 ...)))).. (def
2cc0: 69 6e 65 2d 73 79 6e 74 61 78 20 73 74 72 65 61 ine-syntax strea
2cd0: 6d 2d 6f 66 2d 61 75 78 0a 20 20 20 20 28 73 79 m-of-aux. (sy
2ce0: 6e 74 61 78 2d 72 75 6c 65 73 20 28 69 6e 20 69 ntax-rules (in i
2cf0: 73 29 0a 20 20 20 20 20 20 28 28 73 74 72 65 61 s). ((strea
2d00: 6d 2d 6f 66 2d 61 75 78 20 65 78 70 72 20 62 61 m-of-aux expr ba
2d10: 73 65 29 0a 20 20 20 20 20 20 20 20 28 73 74 72 se). (str
2d20: 65 61 6d 2d 63 6f 6e 73 20 65 78 70 72 20 62 61 eam-cons expr ba
2d30: 73 65 29 29 0a 20 20 20 20 20 20 28 28 73 74 72 se)). ((str
2d40: 65 61 6d 2d 6f 66 2d 61 75 78 20 65 78 70 72 20 eam-of-aux expr
2d50: 62 61 73 65 20 28 76 61 72 20 69 6e 20 73 74 72 base (var in str
2d60: 65 61 6d 29 20 72 65 73 74 20 2e 2e 2e 29 0a 20 eam) rest ...).
2d70: 20 20 20 20 20 20 20 28 73 74 72 65 61 6d 2d 6c (stream-l
2d80: 65 74 20 6c 6f 6f 70 20 28 28 73 74 72 6d 20 73 et loop ((strm s
2d90: 74 72 65 61 6d 29 29 0a 20 20 20 20 20 20 20 20 tream)).
2da0: 20 20 28 69 66 20 28 73 74 72 65 61 6d 2d 6e 75 (if (stream-nu
2db0: 6c 6c 3f 20 73 74 72 6d 29 0a 20 20 20 20 20 20 ll? strm).
2dc0: 20 20 20 20 20 20 20 20 62 61 73 65 0a 20 20 20 base.
2dd0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
2de0: 28 28 76 61 72 20 28 73 74 72 65 61 6d 2d 63 61 ((var (stream-ca
2df0: 72 20 73 74 72 6d 29 29 29 0a 20 20 20 20 20 20 r strm))).
2e00: 20 20 20 20 20 20 20 20 20 20 28 73 74 72 65 61 (strea
2e10: 6d 2d 6f 66 2d 61 75 78 20 65 78 70 72 20 28 6c m-of-aux expr (l
2e20: 6f 6f 70 20 28 73 74 72 65 61 6d 2d 63 64 72 20 oop (stream-cdr
2e30: 73 74 72 6d 29 29 20 72 65 73 74 20 2e 2e 2e 29 strm)) rest ...)
2e40: 29 29 29 29 0a 20 20 20 20 20 20 28 28 73 74 72 )))). ((str
2e50: 65 61 6d 2d 6f 66 2d 61 75 78 20 65 78 70 72 20 eam-of-aux expr
2e60: 62 61 73 65 20 28 76 61 72 20 69 73 20 65 78 70 base (var is exp
2e70: 29 20 72 65 73 74 20 2e 2e 2e 29 0a 20 20 20 20 ) rest ...).
2e80: 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 20 65 (let ((var e
2e90: 78 70 29 29 20 28 73 74 72 65 61 6d 2d 6f 66 2d xp)) (stream-of-
2ea0: 61 75 78 20 65 78 70 72 20 62 61 73 65 20 72 65 aux expr base re
2eb0: 73 74 20 2e 2e 2e 29 29 29 0a 20 20 20 20 20 20 st ...))).
2ec0: 28 28 73 74 72 65 61 6d 2d 6f 66 2d 61 75 78 20 ((stream-of-aux
2ed0: 65 78 70 72 20 62 61 73 65 20 70 72 65 64 3f 20 expr base pred?
2ee0: 72 65 73 74 20 2e 2e 2e 29 0a 20 20 20 20 20 20 rest ...).
2ef0: 20 20 28 69 66 20 70 72 65 64 3f 20 28 73 74 72 (if pred? (str
2f00: 65 61 6d 2d 6f 66 2d 61 75 78 20 65 78 70 72 20 eam-of-aux expr
2f10: 62 61 73 65 20 72 65 73 74 20 2e 2e 2e 29 20 62 base rest ...) b
2f20: 61 73 65 29 29 29 29 0a 0a 20 20 28 64 65 66 69 ase)))).. (defi
2f30: 6e 65 20 28 73 74 72 65 61 6d 2d 72 61 6e 67 65 ne (stream-range
2f40: 20 66 69 72 73 74 20 70 61 73 74 20 2e 20 73 74 first past . st
2f50: 65 70 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 ep). (define
2f60: 73 74 72 65 61 6d 2d 72 61 6e 67 65 0a 20 20 20 stream-range.
2f70: 20 20 20 28 73 74 72 65 61 6d 2d 6c 61 6d 62 64 (stream-lambd
2f80: 61 20 28 66 69 72 73 74 20 70 61 73 74 20 64 65 a (first past de
2f90: 6c 74 61 20 6c 74 3f 29 0a 20 20 20 20 20 20 20 lta lt?).
2fa0: 20 28 69 66 20 28 6c 74 3f 20 66 69 72 73 74 20 (if (lt? first
2fb0: 70 61 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 past).
2fc0: 20 20 28 73 74 72 65 61 6d 2d 63 6f 6e 73 20 66 (stream-cons f
2fd0: 69 72 73 74 20 28 73 74 72 65 61 6d 2d 72 61 6e irst (stream-ran
2fe0: 67 65 20 28 2b 20 66 69 72 73 74 20 64 65 6c 74 ge (+ first delt
2ff0: 61 29 20 70 61 73 74 20 64 65 6c 74 61 20 6c 74 a) past delta lt
3000: 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ?)).
3010: 73 74 72 65 61 6d 2d 6e 75 6c 6c 29 29 29 0a 20 stream-null))).
3020: 20 20 20 28 63 6f 6e 64 20 28 28 6e 6f 74 20 28 (cond ((not (
3030: 6e 75 6d 62 65 72 3f 20 66 69 72 73 74 29 29 20 number? first))
3040: 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d 2d 72 (error 'stream-r
3050: 61 6e 67 65 20 22 6e 6f 6e 2d 6e 75 6d 65 72 69 ange "non-numeri
3060: 63 20 73 74 61 72 74 69 6e 67 20 6e 75 6d 62 65 c starting numbe
3070: 72 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 r")). (
3080: 28 6e 6f 74 20 28 6e 75 6d 62 65 72 3f 20 70 61 (not (number? pa
3090: 73 74 29 29 20 28 65 72 72 6f 72 20 27 73 74 72 st)) (error 'str
30a0: 65 61 6d 2d 72 61 6e 67 65 20 22 6e 6f 6e 2d 6e eam-range "non-n
30b0: 75 6d 65 72 69 63 20 65 6e 64 69 6e 67 20 6e 75 umeric ending nu
30c0: 6d 62 65 72 22 29 29 0a 20 20 20 20 20 20 20 20 mber")).
30d0: 20 20 28 65 6c 73 65 20 28 6c 65 74 20 28 28 64 (else (let ((d
30e0: 65 6c 74 61 20 28 63 6f 6e 64 20 28 28 70 61 69 elta (cond ((pai
30f0: 72 3f 20 73 74 65 70 29 20 28 63 61 72 20 73 74 r? step) (car st
3100: 65 70 29 29 20 28 28 3c 20 66 69 72 73 74 20 70 ep)) ((< first p
3110: 61 73 74 29 20 31 29 20 28 65 6c 73 65 20 2d 31 ast) 1) (else -1
3120: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
3130: 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
3140: 28 6e 75 6d 62 65 72 3f 20 64 65 6c 74 61 29 29 (number? delta))
3150: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3160: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 27 73 (error 's
3170: 74 72 65 61 6d 2d 72 61 6e 67 65 20 22 6e 6f 6e tream-range "non
3180: 2d 6e 75 6d 65 72 69 63 20 73 74 65 70 20 73 69 -numeric step si
3190: 7a 65 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 ze").
31a0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
31b0: 28 28 6c 74 3f 20 28 69 66 20 28 3c 20 30 20 64 ((lt? (if (< 0 d
31c0: 65 6c 74 61 29 20 3c 20 3e 29 29 29 0a 20 20 20 elta) < >))).
31d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
31e0: 20 20 20 20 20 28 73 74 72 65 61 6d 2d 72 61 6e (stream-ran
31f0: 67 65 20 66 69 72 73 74 20 70 61 73 74 20 64 65 ge first past de
3200: 6c 74 61 20 6c 74 3f 29 29 29 29 29 29 29 0a 0a lta lt?)))))))..
3210: 20 20 28 64 65 66 69 6e 65 20 28 73 74 72 65 61 (define (strea
3220: 6d 2d 72 65 66 20 73 74 72 6d 20 6e 29 0a 20 20 m-ref strm n).
3230: 20 20 28 63 6f 6e 64 20 28 28 6e 6f 74 20 28 73 (cond ((not (s
3240: 74 72 65 61 6d 3f 20 73 74 72 6d 29 29 20 28 65 tream? strm)) (e
3250: 72 72 6f 72 20 27 73 74 72 65 61 6d 2d 72 65 66 rror 'stream-ref
3260: 20 22 6e 6f 6e 2d 73 74 72 65 61 6d 20 61 72 67 "non-stream arg
3270: 75 6d 65 6e 74 22 29 29 0a 20 20 20 20 20 20 20 ument")).
3280: 20 20 20 28 28 6e 6f 74 20 28 69 6e 74 65 67 65 ((not (intege
3290: 72 3f 20 6e 29 29 20 28 65 72 72 6f 72 20 27 73 r? n)) (error 's
32a0: 74 72 65 61 6d 2d 72 65 66 20 22 6e 6f 6e 2d 69 tream-ref "non-i
32b0: 6e 74 65 67 65 72 20 61 72 67 75 6d 65 6e 74 22 nteger argument"
32c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 6e )). ((n
32d0: 65 67 61 74 69 76 65 3f 20 6e 29 20 28 65 72 72 egative? n) (err
32e0: 6f 72 20 27 73 74 72 65 61 6d 2d 72 65 66 20 22 or 'stream-ref "
32f0: 6e 65 67 61 74 69 76 65 20 61 72 67 75 6d 65 6e negative argumen
3300: 74 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 t")). (
3310: 65 6c 73 65 20 28 6c 65 74 20 6c 6f 6f 70 20 28 else (let loop (
3320: 28 73 74 72 6d 20 73 74 72 6d 29 20 28 6e 20 6e (strm strm) (n n
3330: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3340: 20 20 20 20 20 28 63 6f 6e 64 20 28 28 73 74 72 (cond ((str
3350: 65 61 6d 2d 6e 75 6c 6c 3f 20 73 74 72 6d 29 20 eam-null? strm)
3360: 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d 2d 72 (error 'stream-r
3370: 65 66 20 22 62 65 79 6f 6e 64 20 65 6e 64 20 6f ef "beyond end o
3380: 66 20 73 74 72 65 61 6d 22 29 29 0a 20 20 20 20 f stream")).
3390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
33a0: 20 20 20 20 28 28 7a 65 72 6f 3f 20 6e 29 20 28 ((zero? n) (
33b0: 73 74 72 65 61 6d 2d 63 61 72 20 73 74 72 6d 29 stream-car strm)
33c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
33d0: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
33e0: 28 6c 6f 6f 70 20 28 73 74 72 65 61 6d 2d 63 64 (loop (stream-cd
33f0: 72 20 73 74 72 6d 29 20 28 2d 20 6e 20 31 29 29 r strm) (- n 1))
3400: 29 29 29 29 29 29 0a 0a 20 20 28 64 65 66 69 6e )))))).. (defin
3410: 65 20 28 73 74 72 65 61 6d 2d 72 65 76 65 72 73 e (stream-revers
3420: 65 20 73 74 72 6d 29 0a 20 20 20 20 28 64 65 66 e strm). (def
3430: 69 6e 65 20 73 74 72 65 61 6d 2d 72 65 76 65 72 ine stream-rever
3440: 73 65 0a 20 20 20 20 20 20 28 73 74 72 65 61 6d se. (stream
3450: 2d 6c 61 6d 62 64 61 20 28 73 74 72 6d 20 72 65 -lambda (strm re
3460: 76 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 v). (if (
3470: 73 74 72 65 61 6d 2d 6e 75 6c 6c 3f 20 73 74 72 stream-null? str
3480: 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 72 m). r
3490: 65 76 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 ev. (
34a0: 73 74 72 65 61 6d 2d 72 65 76 65 72 73 65 20 28 stream-reverse (
34b0: 73 74 72 65 61 6d 2d 63 64 72 20 73 74 72 6d 29 stream-cdr strm)
34c0: 20 28 73 74 72 65 61 6d 2d 63 6f 6e 73 20 28 73 (stream-cons (s
34d0: 74 72 65 61 6d 2d 63 61 72 20 73 74 72 6d 29 20 tream-car strm)
34e0: 72 65 76 29 29 29 29 29 0a 20 20 20 20 28 69 66 rev))))). (if
34f0: 20 28 6e 6f 74 20 28 73 74 72 65 61 6d 3f 20 73 (not (stream? s
3500: 74 72 6d 29 29 0a 20 20 20 20 20 20 20 20 28 65 trm)). (e
3510: 72 72 6f 72 20 27 73 74 72 65 61 6d 2d 72 65 76 rror 'stream-rev
3520: 65 72 73 65 20 22 6e 6f 6e 2d 73 74 72 65 61 6d erse "non-stream
3530: 20 61 72 67 75 6d 65 6e 74 22 29 0a 20 20 20 20 argument").
3540: 20 20 20 20 28 73 74 72 65 61 6d 2d 72 65 76 65 (stream-reve
3550: 72 73 65 20 73 74 72 6d 20 73 74 72 65 61 6d 2d rse strm stream-
3560: 6e 75 6c 6c 29 29 29 0a 0a 20 20 28 64 65 66 69 null))).. (defi
3570: 6e 65 20 28 73 74 72 65 61 6d 2d 73 63 61 6e 20 ne (stream-scan
3580: 70 72 6f 63 20 62 61 73 65 20 73 74 72 6d 29 0a proc base strm).
3590: 20 20 20 20 28 64 65 66 69 6e 65 20 73 74 72 65 (define stre
35a0: 61 6d 2d 73 63 61 6e 0a 20 20 20 20 20 20 28 73 am-scan. (s
35b0: 74 72 65 61 6d 2d 6c 61 6d 62 64 61 20 28 62 61 tream-lambda (ba
35c0: 73 65 20 73 74 72 6d 29 0a 20 20 20 20 20 20 20 se strm).
35d0: 20 28 69 66 20 28 73 74 72 65 61 6d 2d 6e 75 6c (if (stream-nul
35e0: 6c 3f 20 73 74 72 6d 29 0a 20 20 20 20 20 20 20 l? strm).
35f0: 20 20 20 20 20 28 73 74 72 65 61 6d 20 62 61 73 (stream bas
3600: 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 e). (
3610: 73 74 72 65 61 6d 2d 63 6f 6e 73 20 62 61 73 65 stream-cons base
3620: 20 28 73 74 72 65 61 6d 2d 73 63 61 6e 20 28 70 (stream-scan (p
3630: 72 6f 63 20 62 61 73 65 20 28 73 74 72 65 61 6d roc base (stream
3640: 2d 63 61 72 20 73 74 72 6d 29 29 20 28 73 74 72 -car strm)) (str
3650: 65 61 6d 2d 63 64 72 20 73 74 72 6d 29 29 29 29 eam-cdr strm))))
3660: 29 29 0a 20 20 20 20 28 63 6f 6e 64 20 28 28 6e )). (cond ((n
3670: 6f 74 20 28 70 72 6f 63 65 64 75 72 65 3f 20 70 ot (procedure? p
3680: 72 6f 63 29 29 20 28 65 72 72 6f 72 20 27 73 74 roc)) (error 'st
3690: 72 65 61 6d 2d 73 63 61 6e 20 22 6e 6f 6e 2d 70 ream-scan "non-p
36a0: 72 6f 63 65 64 75 72 61 6c 20 61 72 67 75 6d 65 rocedural argume
36b0: 6e 74 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 nt")).
36c0: 28 28 6e 6f 74 20 28 73 74 72 65 61 6d 3f 20 73 ((not (stream? s
36d0: 74 72 6d 29 29 20 28 65 72 72 6f 72 20 27 73 74 trm)) (error 'st
36e0: 72 65 61 6d 2d 73 63 61 6e 20 22 6e 6f 6e 2d 73 ream-scan "non-s
36f0: 74 72 65 61 6d 20 61 72 67 75 6d 65 6e 74 22 29 tream argument")
3700: 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 ). (els
3710: 65 20 28 73 74 72 65 61 6d 2d 73 63 61 6e 20 62 e (stream-scan b
3720: 61 73 65 20 73 74 72 6d 29 29 29 29 0a 0a 20 20 ase strm))))..
3730: 28 64 65 66 69 6e 65 20 28 73 74 72 65 61 6d 2d (define (stream-
3740: 74 61 6b 65 20 6e 20 73 74 72 6d 29 0a 20 20 20 take n strm).
3750: 20 28 64 65 66 69 6e 65 20 73 74 72 65 61 6d 2d (define stream-
3760: 74 61 6b 65 0a 20 20 20 20 20 20 28 73 74 72 65 take. (stre
3770: 61 6d 2d 6c 61 6d 62 64 61 20 28 6e 20 73 74 72 am-lambda (n str
3780: 6d 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 m). (if (
3790: 6f 72 20 28 73 74 72 65 61 6d 2d 6e 75 6c 6c 3f or (stream-null?
37a0: 20 73 74 72 6d 29 20 28 7a 65 72 6f 3f 20 6e 29 strm) (zero? n)
37b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 74 ). st
37c0: 72 65 61 6d 2d 6e 75 6c 6c 0a 20 20 20 20 20 20 ream-null.
37d0: 20 20 20 20 20 20 28 73 74 72 65 61 6d 2d 63 6f (stream-co
37e0: 6e 73 20 28 73 74 72 65 61 6d 2d 63 61 72 20 73 ns (stream-car s
37f0: 74 72 6d 29 20 28 73 74 72 65 61 6d 2d 74 61 6b trm) (stream-tak
3800: 65 20 28 2d 20 6e 20 31 29 20 28 73 74 72 65 61 e (- n 1) (strea
3810: 6d 2d 63 64 72 20 73 74 72 6d 29 29 29 29 29 29 m-cdr strm))))))
3820: 0a 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 6f 74 . (cond ((not
3830: 20 28 73 74 72 65 61 6d 3f 20 73 74 72 6d 29 29 (stream? strm))
3840: 20 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d 2d (error 'stream-
3850: 74 61 6b 65 20 22 6e 6f 6e 2d 73 74 72 65 61 6d take "non-stream
3860: 20 61 72 67 75 6d 65 6e 74 22 29 29 0a 20 20 20 argument")).
3870: 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 69 6e ((not (in
3880: 74 65 67 65 72 3f 20 6e 29 29 20 28 65 72 72 6f teger? n)) (erro
3890: 72 20 27 73 74 72 65 61 6d 2d 74 61 6b 65 20 22 r 'stream-take "
38a0: 6e 6f 6e 2d 69 6e 74 65 67 65 72 20 61 72 67 75 non-integer argu
38b0: 6d 65 6e 74 22 29 29 0a 20 20 20 20 20 20 20 20 ment")).
38c0: 20 20 28 28 6e 65 67 61 74 69 76 65 3f 20 6e 29 ((negative? n)
38d0: 20 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d 2d (error 'stream-
38e0: 74 61 6b 65 20 22 6e 65 67 61 74 69 76 65 20 61 take "negative a
38f0: 72 67 75 6d 65 6e 74 22 29 29 0a 20 20 20 20 20 rgument")).
3900: 20 20 20 20 20 28 65 6c 73 65 20 28 73 74 72 65 (else (stre
3910: 61 6d 2d 74 61 6b 65 20 6e 20 73 74 72 6d 29 29 am-take n strm))
3920: 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 73 )).. (define (s
3930: 74 72 65 61 6d 2d 74 61 6b 65 2d 77 68 69 6c 65 tream-take-while
3940: 20 70 72 65 64 3f 20 73 74 72 6d 29 0a 20 20 20 pred? strm).
3950: 20 28 64 65 66 69 6e 65 20 73 74 72 65 61 6d 2d (define stream-
3960: 74 61 6b 65 2d 77 68 69 6c 65 0a 20 20 20 20 20 take-while.
3970: 20 28 73 74 72 65 61 6d 2d 6c 61 6d 62 64 61 20 (stream-lambda
3980: 28 73 74 72 6d 29 0a 20 20 20 20 20 20 20 20 28 (strm). (
3990: 63 6f 6e 64 20 28 28 73 74 72 65 61 6d 2d 6e 75 cond ((stream-nu
39a0: 6c 6c 3f 20 73 74 72 6d 29 20 73 74 72 65 61 6d ll? strm) stream
39b0: 2d 6e 75 6c 6c 29 0a 20 20 20 20 20 20 20 20 20 -null).
39c0: 20 20 20 20 20 28 28 70 72 65 64 3f 20 28 73 74 ((pred? (st
39d0: 72 65 61 6d 2d 63 61 72 20 73 74 72 6d 29 29 0a ream-car strm)).
39e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39f0: 28 73 74 72 65 61 6d 2d 63 6f 6e 73 20 28 73 74 (stream-cons (st
3a00: 72 65 61 6d 2d 63 61 72 20 73 74 72 6d 29 20 28 ream-car strm) (
3a10: 73 74 72 65 61 6d 2d 74 61 6b 65 2d 77 68 69 6c stream-take-whil
3a20: 65 20 28 73 74 72 65 61 6d 2d 63 64 72 20 73 74 e (stream-cdr st
3a30: 72 6d 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 rm)))).
3a40: 20 20 20 20 20 28 65 6c 73 65 20 73 74 72 65 61 (else strea
3a50: 6d 2d 6e 75 6c 6c 29 29 29 29 0a 20 20 20 20 28 m-null)))). (
3a60: 63 6f 6e 64 20 28 28 6e 6f 74 20 28 73 74 72 65 cond ((not (stre
3a70: 61 6d 3f 20 73 74 72 6d 29 29 20 28 65 72 72 6f am? strm)) (erro
3a80: 72 20 27 73 74 72 65 61 6d 2d 74 61 6b 65 2d 77 r 'stream-take-w
3a90: 68 69 6c 65 20 22 6e 6f 6e 2d 73 74 72 65 61 6d hile "non-stream
3aa0: 20 61 72 67 75 6d 65 6e 74 22 29 29 0a 20 20 20 argument")).
3ab0: 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 70 72 ((not (pr
3ac0: 6f 63 65 64 75 72 65 3f 20 70 72 65 64 3f 29 29 ocedure? pred?))
3ad0: 20 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d 2d (error 'stream-
3ae0: 74 61 6b 65 2d 77 68 69 6c 65 20 22 6e 6f 6e 2d take-while "non-
3af0: 70 72 6f 63 65 64 75 72 61 6c 20 61 72 67 75 6d procedural argum
3b00: 65 6e 74 22 29 29 0a 20 20 20 20 20 20 20 20 20 ent")).
3b10: 20 28 65 6c 73 65 20 28 73 74 72 65 61 6d 2d 74 (else (stream-t
3b20: 61 6b 65 2d 77 68 69 6c 65 20 73 74 72 6d 29 29 ake-while strm))
3b30: 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 73 )).. (define (s
3b40: 74 72 65 61 6d 2d 75 6e 66 6f 6c 64 20 6d 61 70 tream-unfold map
3b50: 70 65 72 20 70 72 65 64 3f 20 67 65 6e 65 72 61 per pred? genera
3b60: 74 6f 72 20 62 61 73 65 29 0a 20 20 20 20 28 64 tor base). (d
3b70: 65 66 69 6e 65 20 73 74 72 65 61 6d 2d 75 6e 66 efine stream-unf
3b80: 6f 6c 64 0a 20 20 20 20 20 20 28 73 74 72 65 61 old. (strea
3b90: 6d 2d 6c 61 6d 62 64 61 20 28 62 61 73 65 29 0a m-lambda (base).
3ba0: 20 20 20 20 20 20 20 20 28 69 66 20 28 70 72 65 (if (pre
3bb0: 64 3f 20 62 61 73 65 29 0a 20 20 20 20 20 20 20 d? base).
3bc0: 20 20 20 20 20 28 73 74 72 65 61 6d 2d 63 6f 6e (stream-con
3bd0: 73 20 28 6d 61 70 70 65 72 20 62 61 73 65 29 20 s (mapper base)
3be0: 28 73 74 72 65 61 6d 2d 75 6e 66 6f 6c 64 20 28 (stream-unfold (
3bf0: 67 65 6e 65 72 61 74 6f 72 20 62 61 73 65 29 29 generator base))
3c00: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 74 ). st
3c10: 72 65 61 6d 2d 6e 75 6c 6c 29 29 29 0a 20 20 20 ream-null))).
3c20: 20 28 63 6f 6e 64 20 28 28 6e 6f 74 20 28 70 72 (cond ((not (pr
3c30: 6f 63 65 64 75 72 65 3f 20 6d 61 70 70 65 72 29 ocedure? mapper)
3c40: 29 20 28 65 72 72 6f 72 20 27 73 74 72 65 61 6d ) (error 'stream
3c50: 2d 75 6e 66 6f 6c 64 20 22 6e 6f 6e 2d 70 72 6f -unfold "non-pro
3c60: 63 65 64 75 72 61 6c 20 6d 61 70 70 65 72 22 29 cedural mapper")
3c70: 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f ). ((no
3c80: 74 20 28 70 72 6f 63 65 64 75 72 65 3f 20 70 72 t (procedure? pr
3c90: 65 64 3f 29 29 20 28 65 72 72 6f 72 20 27 73 74 ed?)) (error 'st
3ca0: 72 65 61 6d 2d 75 6e 66 6f 6c 64 20 22 6e 6f 6e ream-unfold "non
3cb0: 2d 70 72 6f 63 65 64 75 72 61 6c 20 70 72 65 64 -procedural pred
3cc0: 3f 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 ?")). (
3cd0: 28 6e 6f 74 20 28 70 72 6f 63 65 64 75 72 65 3f (not (procedure?
3ce0: 20 67 65 6e 65 72 61 74 6f 72 29 29 20 28 65 72 generator)) (er
3cf0: 72 6f 72 20 27 73 74 72 65 61 6d 2d 75 6e 66 6f ror 'stream-unfo
3d00: 6c 64 20 22 6e 6f 6e 2d 70 72 6f 63 65 64 75 72 ld "non-procedur
3d10: 61 6c 20 67 65 6e 65 72 61 74 6f 72 22 29 29 0a al generator")).
3d20: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
3d30: 28 73 74 72 65 61 6d 2d 75 6e 66 6f 6c 64 20 62 (stream-unfold b
3d40: 61 73 65 29 29 29 29 0a 0a 20 20 28 64 65 66 69 ase)))).. (defi
3d50: 6e 65 20 28 73 74 72 65 61 6d 2d 75 6e 66 6f 6c ne (stream-unfol
3d60: 64 73 20 67 65 6e 20 73 65 65 64 29 0a 20 20 20 ds gen seed).
3d70: 20 28 64 65 66 69 6e 65 20 28 6c 65 6e 2d 76 61 (define (len-va
3d80: 6c 75 65 73 20 67 65 6e 20 73 65 65 64 29 0a 20 lues gen seed).
3d90: 20 20 20 20 20 28 63 61 6c 6c 2d 77 69 74 68 2d (call-with-
3da0: 76 61 6c 75 65 73 0a 20 20 20 20 20 20 20 20 28 values. (
3db0: 6c 61 6d 62 64 61 20 28 29 20 28 67 65 6e 20 73 lambda () (gen s
3dc0: 65 65 64 29 29 0a 20 20 20 20 20 20 20 20 28 6c eed)). (l
3dd0: 61 6d 62 64 61 20 76 73 20 28 2d 20 28 6c 65 6e ambda vs (- (len
3de0: 67 74 68 20 76 73 29 20 31 29 29 29 29 0a 20 20 gth vs) 1)))).
3df0: 20 20 28 64 65 66 69 6e 65 20 75 6e 66 6f 6c 64 (define unfold
3e00: 2d 72 65 73 75 6c 74 2d 73 74 72 65 61 6d 0a 20 -result-stream.
3e10: 20 20 20 20 20 28 73 74 72 65 61 6d 2d 6c 61 6d (stream-lam
3e20: 62 64 61 20 28 67 65 6e 20 73 65 65 64 29 0a 20 bda (gen seed).
3e30: 20 20 20 20 20 20 20 28 63 61 6c 6c 2d 77 69 74 (call-wit
3e40: 68 2d 76 61 6c 75 65 73 0a 20 20 20 20 20 20 20 h-values.
3e50: 20 20 20 28 6c 61 6d 62 64 61 20 28 29 20 28 67 (lambda () (g
3e60: 65 6e 20 73 65 65 64 29 29 0a 20 20 20 20 20 20 en seed)).
3e70: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6e 65 78 (lambda (nex
3e80: 74 20 2e 20 72 65 73 75 6c 74 73 29 0a 20 20 20 t . results).
3e90: 20 20 20 20 20 20 20 20 20 28 73 74 72 65 61 6d (stream
3ea0: 2d 63 6f 6e 73 20 72 65 73 75 6c 74 73 20 28 75 -cons results (u
3eb0: 6e 66 6f 6c 64 2d 72 65 73 75 6c 74 2d 73 74 72 nfold-result-str
3ec0: 65 61 6d 20 67 65 6e 20 6e 65 78 74 29 29 29 29 eam gen next))))
3ed0: 29 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 72 )). (define r
3ee0: 65 73 75 6c 74 2d 73 74 72 65 61 6d 2d 3e 6f 75 esult-stream->ou
3ef0: 74 70 75 74 2d 73 74 72 65 61 6d 0a 20 20 20 20 tput-stream.
3f00: 20 20 28 73 74 72 65 61 6d 2d 6c 61 6d 62 64 61 (stream-lambda
3f10: 20 28 72 65 73 75 6c 74 2d 73 74 72 65 61 6d 20 (result-stream
3f20: 69 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 20 i). (let
3f30: 28 28 72 65 73 75 6c 74 20 28 6c 69 73 74 2d 72 ((result (list-r
3f40: 65 66 20 28 73 74 72 65 61 6d 2d 63 61 72 20 72 ef (stream-car r
3f50: 65 73 75 6c 74 2d 73 74 72 65 61 6d 29 20 28 2d esult-stream) (-
3f60: 20 69 20 31 29 29 29 29 0a 20 20 20 20 20 20 20 i 1)))).
3f70: 20 20 20 28 63 6f 6e 64 20 28 28 70 61 69 72 3f (cond ((pair?
3f80: 20 72 65 73 75 6c 74 29 0a 20 20 20 20 20 20 20 result).
3f90: 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 65 (stre
3fa0: 61 6d 2d 63 6f 6e 73 0a 20 20 20 20 20 20 20 20 am-cons.
3fb0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 72 (car
3fc0: 20 72 65 73 75 6c 74 29 0a 20 20 20 20 20 20 20 result).
3fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
3fe0: 73 75 6c 74 2d 73 74 72 65 61 6d 2d 3e 6f 75 74 sult-stream->out
3ff0: 70 75 74 2d 73 74 72 65 61 6d 20 28 73 74 72 65 put-stream (stre
4000: 61 6d 2d 63 64 72 20 72 65 73 75 6c 74 2d 73 74 am-cdr result-st
4010: 72 65 61 6d 29 20 69 29 29 29 0a 20 20 20 20 20 ream) i))).
4020: 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f 74 ((not
4030: 20 72 65 73 75 6c 74 29 0a 20 20 20 20 20 20 20 result).
4040: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 73 75 (resu
4050: 6c 74 2d 73 74 72 65 61 6d 2d 3e 6f 75 74 70 75 lt-stream->outpu
4060: 74 2d 73 74 72 65 61 6d 20 28 73 74 72 65 61 6d t-stream (stream
4070: 2d 63 64 72 20 72 65 73 75 6c 74 2d 73 74 72 65 -cdr result-stre
4080: 61 6d 29 20 69 29 29 0a 20 20 20 20 20 20 20 20 am) i)).
4090: 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 ((null?
40a0: 72 65 73 75 6c 74 29 20 73 74 72 65 61 6d 2d 6e result) stream-n
40b0: 75 6c 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 ull).
40c0: 20 20 20 20 20 28 65 6c 73 65 20 28 65 72 72 6f (else (erro
40d0: 72 20 27 73 74 72 65 61 6d 2d 75 6e 66 6f 6c 64 r 'stream-unfold
40e0: 73 20 22 63 61 6e 27 74 20 68 61 70 70 65 6e 22 s "can't happen"
40f0: 29 29 29 29 29 29 0a 20 20 20 20 28 64 65 66 69 )))))). (defi
4100: 6e 65 20 28 72 65 73 75 6c 74 2d 73 74 72 65 61 ne (result-strea
4110: 6d 2d 3e 6f 75 74 70 75 74 2d 73 74 72 65 61 6d m->output-stream
4120: 73 20 72 65 73 75 6c 74 2d 73 74 72 65 61 6d 29 s result-stream)
4130: 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 . (let loop
4140: 20 28 28 69 20 28 6c 65 6e 2d 76 61 6c 75 65 73 ((i (len-values
4150: 20 67 65 6e 20 73 65 65 64 29 29 20 28 6f 75 74 gen seed)) (out
4160: 70 75 74 73 20 27 28 29 29 29 0a 20 20 20 20 20 puts '())).
4170: 20 20 20 28 69 66 20 28 7a 65 72 6f 3f 20 69 29 (if (zero? i)
4180: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 . (ap
4190: 70 6c 79 20 76 61 6c 75 65 73 20 6f 75 74 70 75 ply values outpu
41a0: 74 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ts).
41b0: 28 6c 6f 6f 70 20 28 2d 20 69 20 31 29 20 28 63 (loop (- i 1) (c
41c0: 6f 6e 73 20 28 72 65 73 75 6c 74 2d 73 74 72 65 ons (result-stre
41d0: 61 6d 2d 3e 6f 75 74 70 75 74 2d 73 74 72 65 61 am->output-strea
41e0: 6d 20 72 65 73 75 6c 74 2d 73 74 72 65 61 6d 20 m result-stream
41f0: 69 29 20 6f 75 74 70 75 74 73 29 29 29 29 29 0a i) outputs))))).
4200: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 70 72 (if (not (pr
4210: 6f 63 65 64 75 72 65 3f 20 67 65 6e 29 29 0a 20 ocedure? gen)).
4220: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 27 73 (error 's
4230: 74 72 65 61 6d 2d 75 6e 66 6f 6c 64 73 20 22 6e tream-unfolds "n
4240: 6f 6e 2d 70 72 6f 63 65 64 75 72 61 6c 20 61 72 on-procedural ar
4250: 67 75 6d 65 6e 74 22 29 0a 20 20 20 20 20 20 20 gument").
4260: 20 28 72 65 73 75 6c 74 2d 73 74 72 65 61 6d 2d (result-stream-
4270: 3e 6f 75 74 70 75 74 2d 73 74 72 65 61 6d 73 20 >output-streams
4280: 28 75 6e 66 6f 6c 64 2d 72 65 73 75 6c 74 2d 73 (unfold-result-s
4290: 74 72 65 61 6d 20 67 65 6e 20 73 65 65 64 29 29 tream gen seed))
42a0: 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 73 )).. (define (s
42b0: 74 72 65 61 6d 2d 7a 69 70 20 2e 20 73 74 72 6d tream-zip . strm
42c0: 73 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 73 s). (define s
42d0: 74 72 65 61 6d 2d 7a 69 70 0a 20 20 20 20 20 20 tream-zip.
42e0: 28 73 74 72 65 61 6d 2d 6c 61 6d 62 64 61 20 28 (stream-lambda (
42f0: 73 74 72 6d 73 29 0a 20 20 20 20 20 20 20 20 28 strms). (
4300: 69 66 20 28 65 78 69 73 74 73 20 73 74 72 65 61 if (exists strea
4310: 6d 2d 6e 75 6c 6c 3f 20 73 74 72 6d 73 29 0a 20 m-null? strms).
4320: 20 20 20 20 20 20 20 20 20 20 20 73 74 72 65 61 strea
4330: 6d 2d 6e 75 6c 6c 0a 20 20 20 20 20 20 20 20 20 m-null.
4340: 20 20 20 28 73 74 72 65 61 6d 2d 63 6f 6e 73 20 (stream-cons
4350: 28 6d 61 70 20 73 74 72 65 61 6d 2d 63 61 72 20 (map stream-car
4360: 73 74 72 6d 73 29 20 28 73 74 72 65 61 6d 2d 7a strms) (stream-z
4370: 69 70 20 28 6d 61 70 20 73 74 72 65 61 6d 2d 63 ip (map stream-c
4380: 64 72 20 73 74 72 6d 73 29 29 29 29 29 29 0a 20 dr strms)))))).
4390: 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f (cond ((null?
43a0: 20 73 74 72 6d 73 29 20 28 65 72 72 6f 72 20 27 strms) (error '
43b0: 73 74 72 65 61 6d 2d 7a 69 70 20 22 6e 6f 20 73 stream-zip "no s
43c0: 74 72 65 61 6d 20 61 72 67 75 6d 65 6e 74 73 22 tream arguments"
43d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 65 )). ((e
43e0: 78 69 73 74 73 20 28 6c 61 6d 62 64 61 20 28 78 xists (lambda (x
43f0: 29 20 28 6e 6f 74 20 28 73 74 72 65 61 6d 3f 20 ) (not (stream?
4400: 78 29 29 29 20 73 74 72 6d 73 29 0a 20 20 20 20 x))) strms).
4410: 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 27 (error '
4420: 73 74 72 65 61 6d 2d 7a 69 70 20 22 6e 6f 6e 2d stream-zip "non-
4430: 73 74 72 65 61 6d 20 61 72 67 75 6d 65 6e 74 22 stream argument"
4440: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c )). (el
4450: 73 65 20 28 73 74 72 65 61 6d 2d 7a 69 70 20 73 se (stream-zip s
4460: 74 72 6d 73 29 29 29 29 29 0a trms))))).