Permalink
Browse files

primitive stream support

  • Loading branch information...
cpylua committed May 3, 2012
1 parent 8aa51b2 commit be1fe45b3a0155916e331d74639d5b7f226c73bb
Showing with 87 additions and 0 deletions.
  1. +35 −0 lib/stream.scm
  2. +52 −0 test/stream-test.scm
View
@@ -0,0 +1,35 @@
+(define stream-null
+ (delay (cons 'stream 'null)))
+
+(define (stream-null? stream)
+ (eq? (force stream-null)
+ (force stream)))
+
+(define-macro
+ (stream-cons obj stream)
+ `(delay (cons (delay ,obj) (delay ,stream))))
+
+(define (stream-car stream)
+ (force (car (force stream))))
+
+(define (stream-cdr stream)
+ (force (cdr (force stream))))
+
+(define-macro
+ (stream . objs)
+ (fold-right (lambda (a b) `(stream-cons ,a ,b))
+ `stream-null
+ objs))
+
+(define (stream-map proc . streams)
+ (define (stream-map streams)
+ (if (any stream-null? streams)
+ stream-null
+ (stream-cons (apply proc (map stream-car streams))
+ (stream-map (map stream-cdr streams)))))
+ (stream-map streams))
+
+(define (stream-ref stream n)
+ (if (zero? n)
+ (stream-car stream)
+ (stream-ref (stream-cdr stream) (- n 1))))
View
@@ -0,0 +1,52 @@
+(load-lib "stream")
+
+(define stream-123
+ (stream-cons
+ 1
+ (stream-cons
+ 2
+ (stream-cons
+ 3
+ (stream-null)))))
+
+(display-line (stream-car stream-123))
+(display-line (stream-car (stream-cdr stream-123)))
+(display-line (stream-car (stream-cdr (stream-cdr stream-123))))
+
+(define (iter f x)
+ (stream-cons x (iter f (f x))))
+
+(define nats
+ (iter (lambda (x) (+ 1 x)) 0))
+
+(define (stream-add a b)
+ (stream-cons
+ (+ (stream-car a) (stream-car b))
+ (stream-add (stream-cdr a) (stream-cdr b))))
+
+(define evens
+ (stream-add nats nats))
+
+(display-line (stream-car evens))
+(display-line (stream-car (stream-cdr (stream-cdr evens))))
+
+(define s (stream 1 (/ 1 0) 2 4 (+ 89 9)))
+(display-line (stream-car s))
+(display-line (stream-car (stream-cdr (stream-cdr (stream-cdr (stream-cdr s))))))
+; (display-line (stream-car (stream-cdr s)))
+
+(define s (stream 1 (begin (display-line "only once") 2) (/ 200 0)))
+(display-line (stream-car (stream-cdr s)))
+(display-line (stream-car (stream-cdr s)))
+
+(define s
+ (let ((a 100) (b 2))
+ (stream a b)))
+(display-line (stream-car s))
+
+(define odds (stream-map (lambda (x) (- x 1)) evens))
+(display-line (stream-car (stream-cdr (stream-cdr odds))))
+
+(display-line (stream-ref odds 100))
+(display-line (stream-ref evens 10000))
+(display-line (stream-ref evens 100000))

0 comments on commit be1fe45

Please sign in to comment.