home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / prog_oth / scheme.lzh / SCHEME / STREAMS.SCM < prev    next >
Encoding:
Text File  |  1991-08-16  |  1.8 KB  |  88 lines
  1. ;;; streams.scm
  2.  
  3. (define (display-stream s)
  4.   (define (display-stream-elements s)
  5.     (if (empty-stream? s)
  6.     #u
  7.     (begin (display (head s))
  8.            (display " ")
  9.            (display-stream-elements (tail s)))))
  10.   (display "#[ ")
  11.   (display-stream-elements s)
  12.   (display "]")
  13.   #u)
  14.  
  15. (define (map-stream proc s)
  16.   (if (empty-stream? s)
  17.       the-empty-stream
  18.       (cons-stream (proc (head s))
  19.            (map-stream proc (tail s)))))
  20.  
  21. (define (map-2-streams op s1 s2)
  22.   (if (or (empty-stream? s1) (empty-stream? s2))
  23.       (if (and (empty-stream? s1) (empty-stream? s2))
  24.       the-empty-stream
  25.       (error "streams different lengths" (list s1 s2)))
  26.       (cons-stream (op (head s1) (head s2))
  27.            (map-2-streams op (tail s1) (tail s2)))))
  28.  
  29. (define (interleave-streams s1 s2)
  30.   (if (empty-stream? s1)
  31.       s2
  32.       (cons-stream (head s1)
  33.            (interleave-streams s2 (tail s1)))))
  34.  
  35. (define (filter-stream pred s)
  36.   (cond ((empty-stream? s)
  37.      the-empty-stream)
  38.     ((pred (head s))
  39.      (cons-stream (head s)
  40.               (filter-stream pred (tail s))))
  41.     (else
  42.      (filter-stream pred (tail s)))))
  43.  
  44. (define (sieve-stream pred-f s)
  45.   (cons-stream (head s)
  46.     (sieve-stream pred-f
  47.       (filter-stream (pred-f (head s)) (tail s)))))
  48.  
  49. (define (list->stream lst)
  50.   (define (iter l s)
  51.     (if l
  52.     (iter (cdr l) (cons-stream (car l) s))
  53.     s))
  54.   (iter lst the-empty-stream))
  55.  
  56.  
  57.  
  58. ;-------------------------------------------------------------------------------
  59.  
  60. (define ones
  61.   (cons-stream 1 ones))
  62.  
  63. (define (integers-from n)
  64.   (cons-stream n (integers-from (+ 1 n))))
  65.  
  66. (define natural-numbers
  67.   (integers-from 0))
  68.  
  69. (define fibonacci-numbers
  70.   (cons-stream 1
  71.     (cons-stream 1
  72.       (map-2-streams
  73.     +
  74.     fibonacci-stream
  75.     (tail fibonacci-stream)))))
  76.  
  77. (define prime-numbers
  78.   (sieve-stream
  79.     (lambda (divisor)
  80.       (lambda (test-val)
  81.     (not (zero? (remainder test-val divisor)))))
  82.     (integers-from 2)))
  83.  
  84.  
  85.  
  86. ; EOF streams.scm
  87.  
  88.