From: Tim Vaughan <plugd@thelambdalab.xyz>
Date: Mon, 3 May 2021 19:27:56 +0000 (+0200)
Subject: Minor changes to behaviour macros.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=fb6698bac8e29c6579a998f59c26192274b9404e;p=sam.git

Minor changes to behaviour macros.
---

diff --git a/sam-macros.scm b/sam-macros.scm
index 16faba3..cf4f9ac 100644
--- a/sam-macros.scm
+++ b/sam-macros.scm
@@ -1,8 +1,7 @@
 ;; Macro definitions used for SAM behaviour definition
 ;;
 
-(module sam-macros
-    (make-beh define-beh)
+(module sam-macros *
 
   (import scheme
           (chicken base)
@@ -28,5 +27,18 @@
   (define-syntax define-beh
     (syntax-rules ()
       ((_ name rest ...)
-       (define name (make-beh rest ...))))))
+       (define name (make-beh rest ...)))))
+
+  (define-syntax make-actor-with-beh
+    (syntax-rules ()
+      ((_ rest ...)
+       (make-actor
+        (make-beh rest ...)))))
+
+  (define-syntax define-actor-with-beh
+    (syntax-rules ()
+      ((_ name rest ...)
+       (define name
+         (make-actor-with-beh rest ...))))))
+                  
 
diff --git a/sam.scm b/sam.scm
index f09914e..a8ea67b 100644
--- a/sam.scm
+++ b/sam.scm
@@ -42,6 +42,11 @@
     (lambda ()
       (if trace (apply log-msg args)))))
 
+(define (->stringrep arg)
+  (with-output-to-string
+    (lambda ()
+      (write arg))))
+
 ;; Behaviours
 ;; (See also macros defined in sam-macros.scm.)
 
@@ -100,7 +105,7 @@
 
 (define (deliver-message address . message)
   (let ((id (address-id address)))
-    (log-trace "DELIVERING to " id ": " message)
+    (log-trace "DELIVERING to " id ": " (->stringrep message))
     (let loop ((beh (hash-table-ref/default actor-table id #f)))
       (if beh
           (condition-case
@@ -114,9 +119,9 @@
                 (else
                  (log-msg "Warning: behaviour of actor " id " returned invalid value.")))
             (o (exn)
-             (log-msg "Warning: actor " id " crashed evaluating message " message)
+             (log-msg "Warning: actor " id " crashed evaluating message " (->stringrep message))
              (print-error-message o)))
-          (log-msg "Warning: DISCARDING message to unknown actor " id ": " message)))))
+          (log-msg "Warning: DISCARDING message to unknown actor " id ": " (->stringrep message))))))
 
 ;; Scheduler
 
@@ -126,7 +131,7 @@
 (define local-queue (make-fifo))
 
 (define (send-message address . message)
-  (log-trace "SENDING to " address ": " message)
+  (log-trace "SENDING to " address ": " (->stringrep message))
   (apply (if (address-local? address)
              send-local-message
              send-network-message)
@@ -217,23 +222,23 @@
 
 ;; System initialization
 
-(define system-beh
-  (make-beh (self)
-            (('shutdown) =>
-             (log-msg "System actor received shutdown message.")
-             (exit 0)
-             'done)
-
-            (('print strings ...) =>
-             (apply print strings)
-             'sleep)
-
-            (('read reader) =>
-             (mutex-lock! reader-queue-mutex)
-             (fifo-push reader-queue reader)
-             (mutex-unlock! reader-available-mutex)
-             (mutex-unlock! reader-queue-mutex)
-             'sleep)))
+(define-beh system-beh
+  (self)
+  (('shutdown) =>
+   (log-msg "System actor received shutdown message.")
+   (exit 0)
+   'done)
+
+  (('print strings ...) =>
+   (apply print strings)
+   'sleep)
+
+  (('read reader) =>
+   (mutex-lock! reader-queue-mutex)
+   (fifo-push reader-queue reader)
+   (mutex-unlock! reader-available-mutex)
+   (mutex-unlock! reader-queue-mutex)
+   'sleep))
 
 (define (boot-sam)
   (start-console)