Replaced URIs as optional string representation of addresses.
authorTim Vaughan <plugd@thelambdalab.xyz>
Sat, 1 May 2021 19:56:43 +0000 (21:56 +0200)
committerTim Vaughan <plugd@thelambdalab.xyz>
Sat, 1 May 2021 19:56:43 +0000 (21:56 +0200)
chat_client.scm
sam.scm

index f6b16d6..947418f 100644 (file)
@@ -14,7 +14,7 @@
                        "Type '/help' for a list of commands.\n")
          (send-message system 'read self))
         (('show-msg from text)
                        "Type '/help' for a list of commands.\n")
          (send-message system 'read self))
         (('show-msg from text)
-         (send-message system 'print "Message from " from ": " text))
+         (send-message system 'print from "> " text))
         (((? string? str))
          (if (string-prefix? "/" str)
              (let* ((maybe-idx (string-index str #\space))
         (((? string? str))
          (if (string-prefix? "/" str)
              (let* ((maybe-idx (string-index str #\space))
@@ -51,7 +51,7 @@
                         (send-message system 'print "Current recipients:")
                         (let loop ((recipients-left recipients))
                           (unless (null? recipients-left)
                         (send-message system 'print "Current recipients:")
                         (let loop ((recipients-left recipients))
                           (unless (null? recipients-left)
-                            (send-message system 'print (car recipients-left))
+                            (send-message system 'print (address->string (car recipients-left)))
                             (loop (cdr recipients-left)))))))
                  ((or "q" "quit")
                   (send-message system 'shutdown))
                             (loop (cdr recipients-left)))))))
                  ((or "q" "quit")
                   (send-message system 'shutdown))
diff --git a/sam.scm b/sam.scm
index 17c6f41..88ae320 100644 (file)
--- a/sam.scm
+++ b/sam.scm
@@ -22,6 +22,7 @@
           srfi-18 ; threads
           srfi-69 ; hash-table
           uuid ; ids for actors
           srfi-18 ; threads
           srfi-69 ; hash-table
           uuid ; ids for actors
+          uri-generic
           udp
           fifo)
 
           udp
           fifo)
 
   (define (address-port address)
     (caddr address))
   (define (address->string address)
   (define (address-port address)
     (caddr address))
   (define (address->string address)
-    (with-output-to-string
-      (lambda () (write address))))
+    (uri->string
+     (make-uri #:scheme "actor"
+               #:host (address-host address)
+               #:port (address-port address)
+               #:path (list '/ (address-id address)))))
   (define (string->address str)
   (define (string->address str)
-    (with-input-from-string str read))
+    (let ((uri (uri-reference str)))
+      (make-address (uri-host uri)
+                    (uri-port uri)
+                    (cadr (uri-path uri)))))
 
   (define (address-local? address)
     (and (equal? (address-host address) sam-host)
 
   (define (address-local? address)
     (and (equal? (address-host address) sam-host)
@@ -71,7 +78,8 @@
     (let ((id (address-id address)))
       (let ((behaviour (hash-table-ref/default actor-table id '())))
         (if (null? behaviour)
     (let ((id (address-id address)))
       (let ((behaviour (hash-table-ref/default actor-table id '())))
         (if (null? behaviour)
-            (print "Warning: discarded message" message " to unknown actor " address)
+            (print "Warning: discarded message " message
+                   " to unknown actor id " id)
             (match (apply (hash-table-ref actor-table id) (cons address message))
               ('done (hash-table-delete! actor-table id))
               ('sleep 'do-nothing)
             (match (apply (hash-table-ref actor-table id) (cons address message))
               ('done (hash-table-delete! actor-table id))
               ('sleep 'do-nothing)