[shepherd] 02/09: comm: Remove use of (oop goops).

[Ludovic Courtès]

civodul pushed a commit to branch wip-goopsless
in repository shepherd.

commit 2360f989a39b55baf4236d97aba985ea3f8fd0a2
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Apr 5 11:24:45 2023 +0200

    comm: Remove use of (oop goops).
    
    * modules/shepherd/comm.scm (%record-serializers): New variable.
    (define-record-type-serializer): New macro.
    (result->sexp): Turn into a regular procedure.
    * modules/shepherd/service.scm (service->sexp): Define with
    'define-record-type-serializer'.
    (result->sexp): Remove method.
---
 modules/shepherd/comm.scm    | 46 ++++++++++++++++++++++++++++++--------------
 modules/shepherd/service.scm |  6 +-----
 2 files changed, 33 insertions(+), 19 deletions(-)

diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm
index c2ddcc7..c864aaa 100644
--- a/modules/shepherd/comm.scm
+++ b/modules/shepherd/comm.scm
@@ -22,7 +22,6 @@
   #:use-module (shepherd support)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
-  #:use-module (oop goops)
   #:use-module (ice-9 match)
   #:export (open-connection
             open-server-socket
@@ -47,6 +46,7 @@
             read-command
 
             write-reply
+            define-record-type-serializer
             result->sexp
             report-command-error
 
@@ -165,19 +165,37 @@ wrong---premature end-of-file, invalid sexp, etc."
      ;; PORT may be buffered so make sure the command goes out.
      (force-output port))))
 
-;; This generic function must be extended to provide sexp representations of
-;; results that go in <command-reply> objects.
-(define-generic result->sexp)
-
-(define-method (result->sexp (bool <boolean>)) bool)
-(define-method (result->sexp (number <number>)) number)
-(define-method (result->sexp (symbol <symbol>)) symbol)
-(define-method (result->sexp (string <string>)) string)
-(define-method (result->sexp (list <list>)) (map result->sexp list))
-(define-method (result->sexp (pair <pair>))
-  (cons (result->sexp (car pair)) (result->sexp (cdr pair))))
-(define-method (result->sexp (kw <keyword>)) kw)
-(define-method (result->sexp (obj <top>)) (object->string obj))
+(define %record-serializers
+  ;; Hash table mapping record type descriptors (RTDs) to procedures that
+  ;; "convert" instances to an sexp.
+  (make-hash-table 3))
+
+(define-syntax-rule (define-record-type-serializer (name (obj type))
+                      body ...)
+  "Define @var{name} as a procedure that, given @var{obj}, a record of
+@var{type}, returns an sexp serialization of that record."
+  (hashq-set! %record-serializers type
+              (lambda (obj)
+                body ...)))
+
+(define (result->sexp obj)
+  "Return the sexp representation of @var{obj}, a result meant to go in a
+@code{<command-reply>} object."
+  (cond ((or (boolean? obj) (number? obj) (symbol? obj)
+             (string? obj) (keyword? obj))
+         obj)
+        ((list? obj)
+         (map result->sexp obj))
+        ((pair? obj)
+         (cons (result->sexp (car obj)) (result->sexp (cdr obj))))
+        ((struct? obj)
+         (let ((serializer (hashq-ref %record-serializers
+                                      (struct-vtable obj))))
+           (if serializer
+               (serializer obj)
+               (object->string obj))))
+        (else
+         (object->string obj))))
 
 (define (report-command-error error)
   "Report ERROR, an sexp received by a shepherd client in reply to COMMAND, a
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index d221eab..aed0fa1 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -898,7 +898,7 @@ is not already running, and will return SERVICE's canonical 
name in a list."
        ;; FIXME: Implement doc-help.
        (local-output (l10n "Unknown keyword.  Try 'doc root help'."))))))
 
-(define (service->sexp service)
+(define-record-type-serializer (service->sexp (service <service>))
   "Return a representation of SERVICE as an sexp meant to be consumed by
 clients."
   `(service (version 0)                           ;protocol version
@@ -922,10 +922,6 @@ clients."
                   '((transient? #t))
                   '())))
 
-(define-method (result->sexp (service <service>))
-  ;; Serialize SERVICE to an sexp.
-  (service->sexp service))
-
 
 ;;;
 ;;; Service registry.