source: project/release/4/dissector/stream.scm @ 12286

Last change on this file since 12286 was 12286, checked in by felix winkelmann, 13 years ago

ported to chicken-4

File size: 2.9 KB
Line 
1;;;;;; Streams
2
3;;; Copyright (C) 2004, Taylor Campbell
4;;; All rights reserved.
5;;; See the LICENCE file for details.
6
7;;; --------------------
8;;; First, redefinition of the lazy stuff.
9
10(define-record-type rtd/promise
11  (make-promise frozen? value)
12  promise?
13  (frozen? promise-frozen? set-promise-frozen?!)
14  (value   promise-value   set-promise-value!))
15
16(define (eager x) (make-promise #t x))
17
18(define-syntax lazy
19  (syntax-rules ()
20    ((lazy ?expression)
21     (make-promise #f (lambda () ?expression)))))
22#;(define-macro (lazy expression)
23  `(make-promise #f (lambda () ,expression)))
24
25(define-syntax delay
26  (syntax-rules ()
27    ((delay ?expression)
28     (lazy (eager ?expression)))))
29#;(define-macro (delay expression)
30  `(lazy (eager ,expression)))
31
32(define (clobber-promise! promise promise*)
33  (set-promise-frozen?! promise (promise-frozen? promise*))
34  (set-promise-value!   promise (promise-value   promise*)))
35
36(define (force promise)
37  (cond ((not (promise? promise))
38         promise)                       ;?
39        ((promise-frozen? promise)
40         (promise-value promise))
41        (else
42         (clobber-promise! promise ((promise-value promise)))
43         (force promise))))
44
45;;; --------------------
46;;; Streams
47
48(define-syntax stream-cons
49  (syntax-rules ()
50    ((stream-cons ?car ?cdr)
51     (delay (cons ?car ?cdr)))))
52#;(define-macro (stream-cons a d)
53  `(delay (cons ,a ,d)))
54
55(define stream-nil (delay '()))
56
57(define-syntax stream
58  (syntax-rules ()
59    ((stream)
60     stream-nil)
61    ((stream ?elt1 ?elt2 ...)
62     (stream-cons ?elt1 (stream ?elt2 ...)))))
63#;(define-macro (stream . elts)
64  (let recur ((elts elts))
65    (if (null? elts)
66        'stream-nil
67        `(stream-cons ,(car elts)
68                      ,(recur (cdr elts))))))
69
70(define-syntax stream*
71  (syntax-rules ()
72    ((stream* ?tail)
73     ?tail)
74    ((stream* ?elt1 ?elt2 ...)
75     (stream-cons ?elt1 (stream* ?elt2 ...)))))
76#;(define-macro (stream* elt1 . elt2+)
77  (let recur ((elt1 elt1) (elt2+ elt2+))
78    (if (null? elt2+)
79        elt1
80        `(stream-cons ,elt1
81                      ,(recur (car elt2+)
82                              (cdr elt2+))))))
83
84(define (stream-car s) (car (force s)))
85(define (stream-cdr s) (cdr (force s)))
86
87(define (stream-null? s) (null? (force s)))
88(define (stream-pair? s) (pair? (force s)))
89
90(define (stream-car+cdr stream)
91  (values (stream-car stream) (stream-cdr stream)))
92
93(define (stream-maybe-drop stream count)
94  (cond ((zero? count)         stream)
95        ((stream-null? stream) #f)
96        (else (stream-maybe-drop (stream-cdr stream) (- count 1)))))
97
98(define (stream-drop stream count)
99  (cond ((stream-maybe-drop stream count))
100        (else (error "Stream index out of bounds"
101                     count stream 'stream-drop))))
102
103(define (stream-length<? stream len)
104  (cond ((zero? len)           #f)
105        ((stream-null? stream) #t)
106        (else (stream-length<? (stream-cdr stream) (- len 1)))))
Note: See TracBrowser for help on using the repository browser.