quasiquoted-prometheus.diff pasted by siiky on Wed Jul 30 14:43:26 2025

diff --git a/prometheus-impl.scm b/prometheus-impl.scm
index 5613a01a..b2c4394a 100644
--- a/prometheus-impl.scm
+++ b/prometheus-impl.scm
@@ -111,9 +111,9 @@
 
 (define-syntax define-method
   (syntax-rules ()
-    ((_ (obj 'message self resend args ...)
+    ((_ (obj message self resend args ...)
         body1 body ...)
-     (obj 'add-method-slot! 'message
+     (obj 'add-method-slot! `message
           (lambda (self resend args ...)
             body1 body ...)))))
 
@@ -122,7 +122,7 @@
     ((_ name (creation-parent (parent-name parent-object) ...)
         slots ...)
      (define name (let ((o (creation-parent 'clone)))
-                    (o 'add-parent-slot! 'parent-name parent-object)
+                    (o 'add-parent-slot! `parent-name parent-object)
                     ...
                     (define-object/add-slots! o slots ...)
                     o)))))
@@ -134,16 +134,16 @@
     ((_ o ((method-name . method-args) body ...)
         slots ...)
      (begin
-       (o 'add-method-slot! 'method-name (lambda method-args
+       (o 'add-method-slot! `method-name (lambda method-args
                                            body ...))
        (define-object/add-slots! o slots ...)))
     ((_ o (slot-getter slot-setter slot-value)
         slots ...)
      (begin
-       (o 'add-value-slot! 'slot-getter 'slot-setter slot-value)
+       (o 'add-value-slot! `slot-getter `slot-setter slot-value)
        (define-object/add-slots! o slots ...)))
     ((_ o (slot-getter slot-value)
         slots ...)
      (begin
-       (o 'add-value-slot! 'slot-getter slot-value)
+       (o 'add-value-slot! `slot-getter slot-value)
        (define-object/add-slots! o slots ...)))))

quasiquoted-prometheus-v2.diff pasted by siiky 3 days ago

diff --git a/prometheus-impl.scm b/prometheus-impl.scm
index 5613a01..06aa027 100644
--- a/prometheus-impl.scm
+++ b/prometheus-impl.scm
@@ -111,39 +111,50 @@
 
 (define-syntax define-method
   (syntax-rules ()
-    ((_ (obj 'message self resend args ...)
+    ((_ (obj message self resend args ...)
         body1 body ...)
-     (obj 'add-method-slot! 'message
+     (obj 'add-method-slot! `message
           (lambda (self resend args ...)
             body1 body ...)))))
 
 (define-syntax define-object
   (syntax-rules ()
     ((_ name (creation-parent (parent-name parent-object) ...)
-        slots ...)
+        slot ...)
      (define name (let ((o (creation-parent 'clone)))
-                    (o 'add-parent-slot! 'parent-name parent-object)
+                    (o 'add-parent-slot! `parent-name parent-object)
+                    ...
+                    (define-object/add-slot! o slot)
                     ...
-                    (define-object/add-slots! o slots ...)
                     o)))))
 
-(define-syntax define-object/add-slots!
-  (syntax-rules ()
-    ((_ o)
-     (values))
-    ((_ o ((method-name . method-args) body ...)
-        slots ...)
-     (begin
-       (o 'add-method-slot! 'method-name (lambda method-args
-                                           body ...))
-       (define-object/add-slots! o slots ...)))
-    ((_ o (slot-getter slot-setter slot-value)
-        slots ...)
-     (begin
-       (o 'add-value-slot! 'slot-getter 'slot-setter slot-value)
-       (define-object/add-slots! o slots ...)))
-    ((_ o (slot-getter slot-value)
-        slots ...)
-     (begin
-       (o 'add-value-slot! 'slot-getter slot-value)
-       (define-object/add-slots! o slots ...)))))
+(define-syntax define-object/add-slot!
+  (syntax-rules (unquote)
+    ; unquoted
+    ((_ o ((,method-name . method-args)
+           body ...))
+     (o 'add-method-slot! method-name (lambda method-args
+                                        body ...)))
+
+    ((_ o (,slot-getter ,slot-setter slot-value))
+     (o 'add-value-slot! slot-getter slot-setter slot-value))
+
+    ((_ o (slot-getter ,slot-setter slot-value))
+     (o 'add-value-slot! 'slot-getter slot-setter slot-value))
+
+    ((_ o (,slot-getter slot-setter slot-value))
+     (o 'add-value-slot! slot-getter 'slot-setter slot-value))
+
+    ((_ o (,slot-getter slot-value))
+     (o 'add-value-slot! slot-getter slot-value))
+
+    ; not unquoted
+    ((_ o ((method-name . method-args) body ...))
+     (o 'add-method-slot! 'method-name (lambda method-args
+                                         body ...)))
+
+    ((_ o (slot-getter slot-setter slot-value))
+     (o 'add-value-slot! 'slot-getter 'slot-setter slot-value))
+
+    ((_ o (slot-getter slot-value))
+     (o 'add-value-slot! 'slot-getter slot-value))))

prometheus-egg-source-dependencies.diff added by siiky 3 days ago

diff --git a/prometheus.egg b/prometheus.egg
index 9ff0c05..4a0d5ac 100644
--- a/prometheus.egg
+++ b/prometheus.egg
@@ -8,7 +8,9 @@
 (test-dependencies test)
 (components
  (extension hermes
-            (csc-options "-sJ"))
+            (csc-options "-sJ")
+            (source-dependencies hermes-impl.scm hermes.scm))
  (extension prometheus
            (csc-options "-sJ")
+           (source-dependencies prometheus-impl.scm prometheus.scm)
            (component-dependencies hermes))))