source: project/release/5/mailbox/trunk/inline-queue.scm @ 39743

Last change on this file since 39743 was 39743, checked in by Kon Lovett, 7 weeks ago

remove define-inline (except record-variant), cursor test states quit sender

File size: 20.5 KB
Line 
1;;;; inline-queue.scm  -*- Scheme -*-
2;;;; Kon Lovett, Mar '21
3;;;; Kon Lovett, Jun '10
4
5;; Issues
6;;
7;; - Uses (chicken fixnum), (srfi 1), & record-variants
8
9;; Queue Unlimited
10
11;the identifier needs to be defined by somebody
12(define queue-unlimited 'queue-unlimited)
13(define-record-type-variant queue-unlimited (unsafe unchecked inline)
14  (make-queue-unlimited ln hd tl)
15  (queue-unlimited?)
16  (ln queue-unlimited-count queue-unlimited-count-set!)
17  (hd queue-unlimited-first-pair queue-unlimited-first-pair-set!)
18  (tl queue-unlimited-last-pair queue-unlimited-last-pair-set!) )
19
20(define (make-empty-queue-unlimited)
21  (make-queue-unlimited 0 '() '()) )
22
23(define (queue-unlimited-limit q) most-positive-fixnum)
24
25(define (queue-unlimited-room q) (queue-unlimited-limit q))
26
27(define (queue-unlimited-limit-set! q v)
28  (error 'queue-unlimited-limit-set! "immutable" v) )
29
30(define (queue-unlimited-count-add! q n)
31  (queue-unlimited-count-set! q (fx+ (queue-unlimited-count q) n)) )
32
33(define (queue-unlimited-count-sub! q n)
34  (queue-unlimited-count-set! q (fx- (queue-unlimited-count q) n)) )
35
36(define (queue-unlimited-empty? q #!optional (n 0))
37  (fx<= (fx- (queue-unlimited-count q) n) 0) )
38
39(define (queue-unlimited-full? q #!optional (n 0))
40  #f )
41
42(define (queue-unlimited-extract-pair! q targ-pair)
43  ;scan queue list until we find the item to remove
44  (let scanning ((this-pair (queue-unlimited-first-pair q)) (prev-pair '()))
45    ;keep scanning until found
46    (cond
47      ;should not happen but no infinite loops
48      ((null? this-pair)
49        ;note that the pair to extract is in fact gone so ...
50        (error "cannot find queue pair to extract; simultaneous operations?"))
51      ;found?
52      ((eq? this-pair targ-pair)
53        ;so cut out the pair
54        (let ((next-pair (cdr this-pair)))
55          ;at the head of the list, or in the body?
56          (if (null? prev-pair)
57            (queue-unlimited-first-pair-set! q next-pair)
58            (set-cdr! prev-pair next-pair) )
59          ;when the cut pair is the last item update the last pair ref.
60          (when (eq? this-pair (queue-unlimited-last-pair q))
61            (queue-unlimited-last-pair-set! q prev-pair) )
62          (queue-unlimited-count-sub! q 1) ) )
63      ;not found
64      (else
65        (scanning (cdr this-pair) this-pair) ) ) ) )
66
67(define (queue-unlimited-add! q v)
68  (let ((new-pair (cons v '())))
69    (if (null? (queue-unlimited-first-pair q))
70      (queue-unlimited-first-pair-set! q new-pair)
71      (set-cdr! (queue-unlimited-last-pair q) new-pair) )
72    (queue-unlimited-last-pair-set! q new-pair)
73    (queue-unlimited-count-add! q 1)) )
74
75(define (queue-unlimited-remove! q)
76  (let* ((first-pair (queue-unlimited-first-pair q))
77         (next-pair (cdr first-pair)))
78    (queue-unlimited-first-pair-set! q next-pair)
79    (when (null? next-pair) (queue-unlimited-last-pair-set! q '()))
80    (queue-unlimited-count-sub! q 1)
81    (car first-pair) ) )
82
83(define (queue-unlimited-push-back! q v)
84  (let ((newlist (cons v (queue-unlimited-first-pair q))))
85    (queue-unlimited-first-pair-set! q newlist)
86    (when (null? (queue-unlimited-last-pair q))
87      (queue-unlimited-last-pair-set! q newlist) )
88    (queue-unlimited-count-add! q 1) ) )
89
90(define (queue-unlimited-push-back-list! q ls)
91  (let ((newlist (append! (list-copy ls) (queue-unlimited-first-pair q))))
92    (queue-unlimited-first-pair-set! q newlist)
93    (if (null? newlist)
94      (queue-unlimited-last-pair-set! q '())
95      (queue-unlimited-last-pair-set! q (last-pair newlist) ) )
96    (queue-unlimited-count-add! q (length ls)) ) )
97
98(define (make-queue-unlimited-cursor) (cons '() #f))
99(define (queue-unlimited-cursor? c) (pair? c))
100(define (queue-unlimited-cursor-next-pair c) (car c))
101(define (queue-unlimited-cursor-next-pair-set! c v) (set-car! c v))
102(define (queue-unlimited-cursor-prev-pair c) (cdr c))
103(define (queue-unlimited-cursor-prev-pair-set! c v) (set-cdr! c v))
104
105(define (queue-unlimited-cursor-winding? q c)
106  (->boolean (queue-unlimited-cursor-prev-pair c)) )
107
108(define (queue-unlimited-cursor-unwound? q c)
109  (null? (queue-unlimited-cursor-next-pair c)) )
110
111(define (queue-unlimited-cursor-start! q c)
112  ;(queue-unlimited-cursor-prev-pair-set! c #f)
113  (queue-unlimited-cursor-next-pair-set! c (queue-unlimited-first-pair q)) )
114
115;#!eof | *
116(define (queue-unlimited-cursor-next! q c)
117  (let ((curr-pair (queue-unlimited-cursor-next-pair c)))
118    ;anything next?
119    (if (null? curr-pair)
120      #!eof
121      ;then peek into the queue for the next item
122      (let ((item (car curr-pair)))
123        (queue-unlimited-cursor-prev-pair-set! c curr-pair)
124        (queue-unlimited-cursor-next-pair-set! c (cdr curr-pair))
125        item ) ) ) )
126
127(define (queue-unlimited-cursor-continue! q c)
128  ;NOTE assumes 1 next item, so prev-pair is still correct
129  (queue-unlimited-cursor-next-pair-set! c (queue-unlimited-last-pair q)) )
130
131(define (queue-unlimited-cursor-rewind! q c)
132  (queue-unlimited-cursor-prev-pair-set! c #f)
133  (queue-unlimited-cursor-next-pair-set! c '()) )
134
135(define (queue-unlimited-cursor-extract! q c)
136  ;unless 'mailbox-cursor-next' has been called don't remove
137  (and-let* ((prev-pair (queue-unlimited-cursor-prev-pair c)))
138    (queue-unlimited-extract-pair! q prev-pair) ) )
139
140(define (queue-unlimited-delete! q x)
141  (let ((c (make-queue-unlimited-cursor)))
142    (queue-unlimited-cursor-start! q c)
143    (let loop ()
144      (let ((y (queue-unlimited-cursor-next! q c)))
145        (cond
146          ((eof-object? y)
147            #f )
148          ((eq? x y)
149            (queue-unlimited-cursor-extract! q c)
150            #t )
151          (else
152            (loop) ) ) ) ) ) )
153
154(define (queue-unlimited->list q)
155  (let ((c (make-queue-unlimited-cursor)))
156    (queue-unlimited-cursor-start! q c)
157    (let loop ((ls '()))
158      (let ((y (queue-unlimited-cursor-next! q c)))
159        (cond
160          ((eof-object? y)
161            ls )
162          (else
163            (loop (cons y ls)) ) ) ) ) ) )
164
165;; Queue Limited
166
167;circular buffer: s <= e: s = e -> empty, |e - s| = n -> full, s < e -> some
168;
169; inc i: (i + 1)      mod n
170; dec i: (i + (n-1))  mod n
171
172;the identifier needs to be defined by somebody
173(define queue-limited 'queue-limited)
174(define-record-type-variant queue-limited (unsafe unchecked inline)
175  (make-queue-limited vc st ed)
176  (queue-limited?)
177  (vc queue-limited-vector queue-limited-vector-set!)
178  (st queue-limited-start queue-limited-start-set!)
179  (ed queue-limited-end queue-limited-end-set!) )
180
181(define (make-empty-queue-limited lm)
182  ;limit of 2 is lower-bound otherwise always s = e!
183  ;limit + 1 so
184  (make-queue-limited (make-vector (fx+ (fxmax 2 lm) 1) (void)) 0 0) )
185
186(define (queue-limited-peek q i)    (vector-ref (queue-limited-vector q) i))
187(define (queue-limited-poke! q i v) (vector-set! (queue-limited-vector q) i v))
188
189(define (queue-limited-limit q)
190  (fx- (vector-length (queue-limited-vector q)) 1) )
191
192(define (queue-limited-limit-set! q v)
193  (error 'queue-limited-limit-set! "immutable" v) )
194
195(define (queue-limited-index-inc q i)
196  (fxmod (fx+ i 1) (queue-limited-limit q)) )
197
198(define (queue-limited-index-dec q i)
199  (fxmod (fx+ i (fx- (queue-limited-limit q) 1)) (queue-limited-limit q)) )
200
201(define (queue-limited-start-inc! q)
202  (queue-limited-start-set! q (queue-limited-index-inc q (queue-limited-start q))) )
203
204(define (queue-limited-start-dec! q)
205  (queue-limited-start-set! q (queue-limited-index-dec q (queue-limited-start q))) )
206
207(define (queue-limited-end-inc! q)
208  (queue-limited-end-set! q (queue-limited-index-inc q (queue-limited-end q))) )
209
210(define (queue-limited-end-dec! q)
211  (queue-limited-end-set! q (queue-limited-index-dec q (queue-limited-end q))) )
212
213(define (queue-limited-count q)
214  (fxabs (fx- (queue-limited-end q) (queue-limited-start q))) )
215
216(define (queue-limited-count-set! q v)
217  (error 'queue-limited-count-set! "immutable" v) )
218
219(define (queue-limited-empty? q #!optional (n 0))
220  (fx<= (fx- (queue-limited-count q) n) 0) )
221
222(define (queue-limited-full? q #!optional (n 0))
223  (fx>= (fx+ (queue-limited-count q) n) (queue-limited-limit q)) )
224
225(define (queue-limited-room q)
226  (fx- (queue-limited-limit q) (queue-limited-count q)) )
227
228(define (queue-limited-empty? q #!optional (n 0))
229  (fx<= (fx- (queue-limited-count q) n) 0) )
230
231(define (queue-limited-full? q #!optional (n 0))
232  (fx>= (fx+ (queue-limited-count q) n) (queue-limited-limit q)) )
233
234(define (queue-limited-add! q v)
235  (queue-limited-poke! q (queue-limited-end q) v)
236  (queue-limited-end-inc! q) )
237
238(define (queue-limited-remove! q)
239  (let ((v (queue-limited-peek q (queue-limited-start q))))
240    (queue-limited-start-inc! q)
241    v ) )
242
243(define (queue-limited-push-back! q v)
244  (queue-limited-start-dec! q)
245  (queue-limited-poke! q (queue-limited-start q) v) )
246
247(define (queue-limited-push-back-list! q ls)
248  ;assert enough room at the inn!
249  ;move "down" from start to start-1; kinda like extract below
250  (let loop ((i (queue-limited-start q)) (ls (reverse ls)))
251    (if (null? ls)
252      (queue-limited-start-set! q i)
253      (let ((i-1 (queue-limited-index-dec q i)))
254        (queue-limited-poke! q i-1 (car ls))
255        (loop i-1 (cdr ls)) ) ) ) )
256
257(define (make-queue-limited-cursor) (cons -1 (void)))
258(define (queue-limited-cursor? c) (pair? c))
259(define (queue-limited-cursor-index c) (car c))
260(define (queue-limited-cursor-index-set! c v) (set-car! c v))
261
262(define (queue-limited-cursor-winding? q c)
263  (fx<= 0 (queue-limited-cursor-index c)) )
264
265(define (queue-limited-cursor-unwound? q c)
266  (fx= (queue-limited-end q) (queue-limited-cursor-index c)) )
267
268(define (queue-limited-cursor-start! q c)
269  (queue-limited-cursor-index-set! c (queue-limited-start q)) )
270
271;#!eof | *
272(define (queue-limited-cursor-next! q c)
273  (cond
274    ((queue-limited-cursor-unwound? q c) #!eof)
275    (else
276      (let ((v (queue-limited-peek q (queue-limited-cursor-index c))))
277        (queue-limited-cursor-index-set! c
278          (queue-limited-index-inc q (queue-limited-cursor-index c)))
279        v ) ) ) )
280
281(define (queue-limited-cursor-continue! q c)
282  (queue-limited-cursor-index-set! c
283    (queue-limited-index-dec q (queue-limited-cursor-index c))) )
284
285(define (queue-limited-cursor-rewind! q c)
286  (queue-limited-cursor-index-set! c -1) )
287
288(define (queue-limited-cursor-extract! q c)
289  ;unless 'mailbox-cursor-next' has been called don't remove
290  (when (queue-limited-cursor-winding? q c)
291    ;move "up" from i-1 to i until i = start
292    (let loop ((i (queue-limited-index-dec q (queue-limited-cursor-index c))))
293      (let ((i-1 (queue-limited-index-dec q i)))
294        (queue-limited-poke! q i (queue-limited-peek q i-1))
295        (if (fx= (queue-limited-start q) i-1)
296          (queue-limited-start-set! q i)
297          (loop i-1) ) ) ) ) )
298
299(define (queue-limited-delete! q x)
300  (let ((c (make-queue-limited-cursor)))
301    (queue-limited-cursor-start! q c)
302    (let loop ()
303      (let ((y (queue-limited-cursor-next! q c)))
304        (cond
305          ((eof-object? y)
306            #f )
307          ((eq? x y)
308            (queue-limited-cursor-extract! q c)
309            #t )
310          (else
311            (loop) ) ) ) ) ) )
312
313(define (queue-limited->list q)
314  (let ((vc (queue-limited-vector q)) (st (queue-limited-start q)))
315    (let loop ((ed (queue-limited-count q)) (ls '()))
316      (if (fx= st ed)
317        ls
318        (let ((ed (queue-limited-index-dec q ed)))
319          (loop ed (cons (vector-ref vc ed) ls)) ) ) ) ) )
320
321;; Queue Unbuffered
322
323;the identifier needs to be defined by somebody
324(define queue-unbuffered 'queue-unbuffered)
325(define-record-type-variant queue-unbuffered (unsafe unchecked inline)
326  (make-queue-unbuffered vd vl)
327  (queue-unbuffered?)
328  (vd queue-unbuffered-maybe? queue-unbuffered-maybe-set!)
329  (vl queue-unbuffered-value queue-unbuffered-value-set!) )
330
331(define (make-empty-queue-unbuffered)
332  (make-queue-unbuffered #f (void)) )
333
334(define (queue-unbuffered-limit q) 1)
335
336(define (queue-unbuffered-limit-set! q v)
337  (error 'queue-unbuffered-limit-set! "immutable" v) )
338
339(define (queue-unbuffered-count q)
340  (if (queue-unbuffered-maybe? q) 1 0) )
341
342(define (queue-unbuffered-count-set! q v)
343  (error 'queue-unbuffered-count-set! "immutable" v) )
344
345(define (queue-unbuffered-empty? q #!optional (n 0))
346  (or (fx< 0 n)
347      (not (queue-unbuffered-maybe? q))) )
348
349(define (queue-unbuffered-full? q #!optional (n 0))
350  (or (fx< 0 n)
351      (queue-unbuffered-maybe? q)) )
352
353(define (queue-unbuffered-room q)
354  (if (queue-unbuffered-maybe? q) 0 1) )
355
356(define (queue-unbuffered-add! q v)
357  (queue-unbuffered-maybe-set! q #t)
358  (queue-unbuffered-value-set! q v) )
359
360(define (queue-unbuffered-remove! q)
361  (let ((v (queue-unbuffered-value q)))
362    (queue-unbuffered-maybe-set! q #f)
363    (queue-unbuffered-value-set! q (void))
364    v ) )
365
366(define (queue-unbuffered-push-back! q v)
367  (queue-unbuffered-add! q v) )
368
369(define (queue-unbuffered-push-back-list! q ls)
370  ;assert length ls = 1
371  (queue-unbuffered-add! q (car ls)) )
372
373(define (make-queue-unbuffered-cursor) (cons -1 (void)))
374(define (queue-unbuffered-cursor? c) (pair? c))
375(define (queue-unbuffered-cursor-index c) (car c))
376(define (queue-unbuffered-cursor-index-set! c v) (set-car! c v))
377
378(define (queue-unbuffered-cursor-winding? q c)
379  (fx<= 0 (queue-unbuffered-cursor-index c)) )
380
381(define (queue-unbuffered-cursor-unwound? q c)
382  (fx= 1 (queue-unbuffered-cursor-index c)) )
383
384(define (queue-unbuffered-cursor-start! q c)
385  (queue-unbuffered-cursor-index-set! c 0) )
386
387;#!eof | *
388(define (queue-unbuffered-cursor-next! q c)
389  (cond
390    ((queue-unbuffered-cursor-unwound? q c) #!eof)
391    ((not (queue-unbuffered-maybe? q))      #!eof)
392    (else
393      (queue-unbuffered-cursor-index-set! c 1)
394      (queue-unbuffered-value q) ) ) )
395
396(define (queue-unbuffered-cursor-continue! q c)
397  (queue-unbuffered-cursor-index-set! c 0) )
398
399(define (queue-unbuffered-cursor-rewind! q c)
400  (queue-unbuffered-cursor-index-set! c -1) )
401
402(define (queue-unbuffered-cursor-extract! q c)
403  ;unless 'mailbox-cursor-next' has been called don't remove
404  (when (queue-unbuffered-cursor-winding? q c)
405    (queue-unbuffered-maybe-set! q #f) ) )
406
407(define (queue-unbuffered-delete! q x)
408  (when (and (queue-unbuffered-maybe? q) (eq? (queue-unbuffered-value q) x))
409    (queue-unbuffered-maybe-set! q #f) ) )
410
411(define (queue-unbuffered->list q)
412  (if (queue-unbuffered-maybe? q)
413    (list (queue-unbuffered-value q ))
414    '() ) )
415
416;; Queue Generic
417
418(define (valid-queue-limit? lm)
419  (or (boolean? lm) (and (fixnum? lm) (positive? lm))) )
420
421(define (make-empty-queue lm)
422  ;(assert (valid-queue-limit? lm))
423  (cond
424    ((not lm)       (make-empty-queue-unlimited))
425    ((fixnum? lm)   (make-empty-queue-limited lm))
426    (else           (make-empty-queue-unbuffered)) ) )
427
428(define (queue? x)
429  (or
430    (queue-unlimited? x)
431    (queue-limited? x)
432    (queue-unbuffered? x) ) )
433
434(define (queue-limit q)
435  (cond
436    ((queue-unlimited? q)  (queue-unlimited-limit q))
437    ((queue-limited? q)    (queue-limited-limit q))
438    (else                  (queue-unbuffered-limit q)) ) )
439
440(define (queue-limit-set! q v)
441  (cond
442    ((queue-unlimited? q)  (queue-unlimited-limit-set! q v))
443    ((queue-limited? q)    (queue-limited-limit-set! q v))
444    (else                  (queue-unbuffered-limit-set! q v)) ) )
445
446(define (queue-count q)
447  (cond
448    ((queue-unlimited? q)  (queue-unlimited-count q))
449    ((queue-limited? q)    (queue-limited-count q))
450    (else                  (queue-unbuffered-count q)) ) )
451
452(define (queue-count-set! q v)
453  (cond
454    ((queue-unlimited? q)  (queue-unlimited-count-set! q v))
455    ((queue-limited? q)    (queue-limited-count-set! q v))
456    (else                  (queue-unbuffered-count-set! q v)) ) )
457
458(define (queue-room q)
459  (cond
460    ((queue-unlimited? q)  (queue-unlimited-room q))
461    ((queue-limited? q)    (queue-limited-room q))
462    (else                  (queue-unbuffered-room q)) ) )
463
464(define (queue-empty? q #!optional (n 0))
465  (cond
466    ((queue-unlimited? q)  (queue-unlimited-empty? q))
467    ((queue-limited? q)    (queue-limited-empty? q))
468    (else                  (queue-unbuffered-empty? q)) ) )
469
470(define (queue-full? q #!optional (n 0))
471  (cond
472    ((queue-unlimited? q)  (queue-unlimited-full? q))
473    ((queue-limited? q)    (queue-limited-full? q))
474    (else                  (queue-unbuffered-full? q)) ) )
475
476(define (queue-empty-error loc q) (error loc "queue empty" q))
477(define (queue-full-error loc q v) (error loc "queue full" q v))
478
479(define (queue-add!? q v)
480  (if (queue-full? q)
481    (values #f (void))
482    (values #t
483      (cond
484        ((queue-unlimited? q)  (queue-unlimited-add! q v))
485        ((queue-limited? q)    (queue-limited-add! q v))
486        (else                  (queue-unbuffered-add! q v)))) ) )
487
488(define (queue-remove!? q)
489  (if (queue-empty? q)
490    (values #f (void))
491    (values #t
492      (cond
493        ((queue-unlimited? q)  (queue-unlimited-remove! q))
494        ((queue-limited? q)    (queue-limited-remove! q))
495        (else                  (queue-unbuffered-remove! q)))) ) )
496
497(define (queue-push-back!? q v)
498  (if (queue-full? q)
499    (values #f (void))
500    (values #t
501      (cond
502        ((queue-unlimited? q)  (queue-unlimited-push-back! q v))
503        ((queue-limited? q)    (queue-limited-push-back! q v))
504        (else                  (queue-unbuffered-push-back! q v)))) ) )
505
506(define (queue-push-back-list!? q ls)
507  (if (queue-full? q (length ls))
508    (values #f (void))
509    (values #t
510      (cond
511        ((queue-unlimited? q)  (queue-unlimited-push-back-list! q ls))
512        ((queue-limited? q)    (queue-limited-push-back-list! q ls))
513        (else                  (queue-unbuffered-push-back-list! q ls)))) ) )
514
515(define (queue-add! q v
516                  #!optional
517                  (on-full (lambda () (queue-full-error 'queue-add! q v))))
518  (let loop ()
519    (let-values (((succ? val) (queue-add!? q v)))
520      (unless succ?
521        (on-full)
522        (loop) )
523      val ) ) )
524
525(define (queue-remove! q
526                  #!optional
527                  (on-empty (lambda () (queue-empty-error 'queue-remove! q))))
528  (let loop ()
529    (let-values (((succ? val) (queue-remove!? q)))
530      (unless succ?
531        (on-empty)
532        (loop) )
533      val ) ) )
534
535(define (queue-push-back! q v
536                  #!optional
537                  (on-full (lambda () (queue-full-error 'queue-push-back! q v))))
538  (let loop ()
539    (let-values (((succ? val) (queue-push-back!? q v)))
540      (unless succ?
541        (on-full)
542        (loop) )
543      val ) ) )
544
545(define (queue-push-back-list! q ls
546                  #!optional
547                  (on-full (lambda () (queue-full-error 'queue-push-back-list! q ls))))
548  (let loop ()
549    (let-values (((succ? val) (queue-push-back-list!? q ls)))
550      (unless succ?
551        (on-full)
552        (loop) )
553      val ) ) )
554
555(define (make-queue-cursor q)
556  (cond
557    ((queue-unlimited? q)  (make-queue-unlimited-cursor))
558    ((queue-limited? q)    (make-queue-limited-cursor))
559    (else                  (make-queue-unbuffered-cursor)) ) )
560
561(define (queue-cursor-winding? q c)
562  (cond
563    ((queue-unlimited? q)  (queue-unlimited-cursor-winding? q c))
564    ((queue-limited? q)    (queue-limited-cursor-winding? q c))
565    (else                  (queue-unbuffered-cursor-winding? q c)) ) )
566
567(define (queue-cursor-unwound? q c)
568  (cond
569    ((queue-unlimited? q)  (queue-unlimited-cursor-unwound? q c))
570    ((queue-limited? q)    (queue-limited-cursor-unwound? q c))
571    (else                  (queue-unbuffered-cursor-unwound? q c)) ) )
572
573(define (queue-cursor-rewind! q c)
574  (cond
575    ((queue-unlimited? q)  (queue-unlimited-cursor-rewind! q c))
576    ((queue-limited? q)    (queue-limited-cursor-rewind! q c))
577    (else                  (queue-unbuffered-cursor-rewind! q c)) ) )
578
579(define (queue-cursor-start! q c)
580  (cond
581    ((queue-unlimited? q)  (queue-unlimited-cursor-start! q c))
582    ((queue-limited? q)    (queue-limited-cursor-start! q c))
583    (else                  (queue-unbuffered-cursor-start! q c)) ))
584
585;#!eof | *
586(define (queue-cursor-next! q c)
587 (cond
588    ((queue-unlimited? q)  (queue-unlimited-cursor-next! q c))
589    ((queue-limited? q)    (queue-limited-cursor-next! q c))
590    (else                  (queue-unbuffered-cursor-next! q c)) ))
591
592(define (queue-cursor-continue! q c)
593 (cond
594    ((queue-unlimited? q)  (queue-unlimited-cursor-continue! q c))
595    ((queue-limited? q)    (queue-limited-cursor-continue! q c))
596    (else                  (queue-unbuffered-cursor-continue! q c)) ))
597
598(define (queue-cursor-extract! q c)
599  (cond
600    ((queue-unlimited? q)  (queue-unlimited-cursor-extract! q c))
601    ((queue-limited? q)    (queue-limited-cursor-extract! q c))
602    (else                  (queue-unbuffered-cursor-extract! q c)) ) )
603
604(define (queue-delete! q x)
605  (cond
606    ((queue-unlimited? q)  (queue-unlimited-delete! q x))
607    ((queue-limited? q)    (queue-limited-delete! q x))
608    (else                  (queue-unbuffered-delete! q x)) ) )
609
610(define (queue->list q)
611  (cond
612    ((queue-unlimited? q)  (queue-unlimited->list q))
613    ((queue-limited? q)    (queue-limited->list q))
614    (else                  (queue-unbuffered->list q)) ) )
Note: See TracBrowser for help on using the repository browser.