blob: 4e8ed8713ad61ee34b79dad2e39c31c66a7dcbbe (
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
|
(define-module (hnh util atomic-stack)
:use-module (srfi srfi-18) ; Threading
:use-module (rnrs records syntactic)
:use-module (rnrs exceptions)
:use-module (hnh util atomic)
:use-module ((hnh util type) :select (typecheck))
:use-module ((hnh util) :select (begin1))
:export (atomic-stack
atomic-stack?
stack-peek stack->list
push! pop!))
(define-record-type (stack %atomic-stack atomic-stack?)
(fields (mutable contents)
mutex)
(sealed #t)
(opaque #t))
(define (atomic-stack)
(%atomic-stack '() (make-mutex)))
(define (push! value stack)
(typecheck stack atomic-stack?)
(with-mutex (stack-mutex stack)
(stack-contents-set!
stack
(cons value (stack-contents stack)))))
(define (stack-peek stack)
(typecheck stack atomic-stack?)
(car (stack-contents stack)))
(define (pop! stack)
(typecheck stack atomic-stack?)
(with-mutex (stack-mutex stack)
(guard (_ (else #f))
(begin1 (stack-peek stack)
(stack-contents-set!
stack (cdr (stack-contents stack)))))))
(define (stack->list stack)
(stack-contents stack))
|
