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))))