Adding README file
[tinymsg.git] / tinymsg.scm
1 ;;; tinymsg, a GNU Guile messages module for communicating threads
2 ;;; Copyright (C) 2015 by Javier Sancho Fernandez <jsf at jsancho dot org>
3 ;;;
4 ;;; This program is free software: you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published by
6 ;;; the Free Software Foundation, either version 3 of the License, or
7 ;;; (at your option) any later version.
8 ;;;
9 ;;; This program is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 ;;; GNU General Public License for more details.
13 ;;;
14 ;;; You should have received a copy of the GNU General Public License
15 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
16
17
18 (define-module (tinymsg)
19   #:use-module (ice-9 q)
20   #:use-module (ice-9 threads)
21   #:use-module (ice-9 vlist)
22   #:use-module (srfi srfi-9)
23   #:export (send-message
24             receive-message
25             wait-message
26             flush-messages))
27
28
29 (define-record-type <msgbox>
30   (make-msgbox mutex condvar queue)
31   msgbox?
32   (mutex    msgbox-mutex)
33   (condvar  msgbox-condvar)
34   (queue    msgbox-queue))
35
36 (define msgboxes vlist-null)
37 (define msgboxes-mutex (make-recursive-mutex))
38
39 (define (new-msgbox name)
40   "Create a new msgbox for receiving messages"
41   (with-mutex msgboxes-mutex
42     (let ((msgbox (make-msgbox (make-mutex) (make-condition-variable) (make-q))))
43       (set! msgboxes (vhash-cons name msgbox msgboxes))
44       msgbox)))
45
46 (define (get-msgbox name)
47   "Get a msgbox or create a new one if doesn't exists"
48   (with-mutex msgboxes-mutex
49     (let ((msgbox (vhash-assoc name msgboxes)))
50       (cond (msgbox
51              (cdr msgbox))
52             (else
53              (new-msgbox name))))))
54
55 (define (send-message to message)
56   "Get msgbox from destination and queue the message"
57   (let ((msgbox (get-msgbox to)))
58     (with-mutex (msgbox-mutex msgbox)
59       (enq! (msgbox-queue msgbox) message)
60       (signal-condition-variable (msgbox-condvar msgbox))))
61   message)
62
63 (define (receive-message name)
64   "Get msgbox and retrieve a message without waiting"
65   (let ((msgbox (get-msgbox name)))
66     (with-mutex (msgbox-mutex msgbox)
67       (let ((queue (msgbox-queue msgbox)))
68         (if (not (q-empty? queue))
69             (deq! queue))))))
70
71 (define (wait-message name)
72   "Get msgbox and wait for a message"
73   (let ((msgbox (get-msgbox name)))
74     (let ((mutex (msgbox-mutex msgbox))
75           (condvar (msgbox-condvar msgbox))
76           (queue (msgbox-queue msgbox)))
77       (with-mutex mutex
78         (if (or (not (q-empty? queue))
79                 (wait-condition-variable condvar mutex))
80             (deq! queue))))))
81
82 (define (flush-messages name)
83   "Print all messages from the msgbox"
84   (let ((msgbox (get-msgbox name)))
85     (with-mutex (msgbox-mutex msgbox)
86       (let flush ((queue (msgbox-queue msgbox)))
87         (cond ((not (q-empty? queue))
88                (format #t "~a got ~a~%" name (deq! queue))
89                (flush queue)))))))