blob: 2ab0c2ef2f9e193c9fd388e7ad53fd67e9d3245e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
(define-module (hnh util atomic-queue)
:use-module (srfi srfi-18) ; Threading
:use-module (rnrs records syntactic)
:use-module (rnrs exceptions)
;; :use-module (rnrs mutable-pair)
:use-module (hnh util atomic)
:use-module (hnh util type)
:use-module ((hnh util) :select (begin1))
:export (atomic-queue
atomic-queue?
queue-peek queue->list
enqueue! dequeue!))
;;; Items are added at the back, and poped from the front
(define-record-type (queue %atomic-queue atomic-queue?)
(fields front
(mutable back)
front-mutex back-mutex)
(sealed #t)
(opaque #t))
(define (atomic-queue)
(let ((p (list 'FRONT)))
(%atomic-queue p p (make-mutex) (make-mutex))))
(define (enqueue! value q)
(typecheck q atomic-queue?)
(with-mutex (queue-back-mutex q)
(set-cdr! (queue-back q) (list value))
(queue-back-set! q (cdr (queue-back q)))))
(define (queue-peek q)
(typecheck q atomic-queue?)
(cadr (queue-front q)))
(define (dequeue! q)
(typecheck q atomic-queue?)
(with-mutex (queue-front-mutex q)
(guard (_ (else #f))
(begin1 (queue-peek q)
(set-cdr! (queue-front q)
(cddr (queue-front q)))))))
(define (queue->list q)
(typecheck q atomic-queue?)
(cdr (queue-front q)))
|
