4 files changed, 105 insertions, 1 deletions
diff --git a/module/hnh/util/atomic-queue.scm b/module/hnh/util/atomic-queue.scm
new file mode 100644
index 00000000..2ab0c2ef
--- /dev/null
+++ b/module/hnh/util/atomic-queue.scm
@@ -0,0 +1,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)))
diff --git a/module/hnh/util/atomic-stack.scm b/module/hnh/util/atomic-stack.scm
new file mode 100644
index 00000000..6b17724d
--- /dev/null
+++ b/module/hnh/util/atomic-stack.scm
@@ -0,0 +1,43 @@
+(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 (stack->list stack)
+  (stack-contents stack))
+
+(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)))))))
+
diff --git a/module/hnh/util/atomic.scm b/module/hnh/util/atomic.scm
new file mode 100644
index 00000000..1deba2c1
--- /dev/null
+++ b/module/hnh/util/atomic.scm
@@ -0,0 +1,11 @@
+(define-module (hnh util atomic)
+  :use-module (srfi srfi-18)
+  :export (with-mutex))
+
+(define-syntax with-mutex
+  (syntax-rules ()
+    ((_ mutex body ...)
+     (dynamic-wind
+       (lambda () (mutex-lock! mutex))
+       (lambda () body ...)
+       (lambda () (mutex-unlock! mutex))))))
diff --git a/module/hnh/util/coverage.scm b/module/hnh/util/coverage.scm
index 2517e81f..9b76411b 100644
--- a/module/hnh/util/coverage.scm
+++ b/module/hnh/util/coverage.scm
@@ -63,7 +63,7 @@
    (fold (lambda (line state)
            (match (parse-coverage-line line)
              (('DA line hits)
-              (modify state (compose-lens car* lines)
+              (modify state (compose-lenses car* lines)
                       (lambda (lines) (cons (cons line hits) lines))))
              (('SF source)
               (set state car* filename source))
@@ -86,6 +86,7 @@
                "Can only merge coverage data for the same file, got ~s and ~s"
                (list (filename a) (filename b))
                #f))
+  #;
   (unless (= (total-lines a) (total-lines b))
     (scm-error 'misc-error "merge-coverage"
                "Mismatch between found lines. Is it really the same file? File: ~s, got ~s and ~s"