* Keywords in GOOPS methods v2
@ 2024-11-24 14:40 Mikael Djurfeldt
2024-11-24 14:43 ` Mikael Djurfeldt
0 siblings, 1 reply; 3+ messages in thread
From: Mikael Djurfeldt @ 2024-11-24 14:40 UTC (permalink / raw)
To: guile-user, guile-devel, Ludovic Courtès, Andy Wingo
Cc: Jan Nieuwenhuizen, Tomas Volf, Maxime Devos, David Pirotte,
Mikael Djurfeldt
[-- Attachment #1.1: Type: text/plain, Size: 896 bytes --]
This is my second attempt at introducing keyword aware methods in GOOPS.
I was split but finally decided to go with keeping keyword non-aware
define-method and method and introducing keyword aware new syntax method*
and define-method*. Arguments are:
1. It preserves simplicity in method and define-method such that other
implementations (like guile-hoot) can choose to only define these (and
possibly provide something like Mark's macro doe define-method*).
2. It aligns with lambda* and define*.
3. It is somewhat better at protecting backward compatibility.
4. It preserves the option to also in the internal implementation use
something like Mark's macro once this gives equal performance.
I've also committed these changes to
https://github.com/mdjurfeldt/guile/tree/goops-keyword
I'm going to start documenting this now and will then commit it to the
Guile repo.
Best regards,
Mikael
[-- Attachment #1.2: Type: text/html, Size: 1221 bytes --]
[-- Attachment #2: goops-kw-patch-2.patch --]
[-- Type: text/x-patch, Size: 13840 bytes --]
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 8ed68694c..01bf1612e 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -33,9 +33,10 @@
#:use-module ((language tree-il primitives)
:select (add-interesting-primitive!))
#:export-syntax (define-class class standard-define-class
- define-generic define-accessor define-method
+ define-generic define-accessor
+ define-method define-method*
define-extended-generic define-extended-generics
- method)
+ method method*)
#:export ( ;; The root of everything.
<top>
<class> <object>
@@ -2024,8 +2025,7 @@ function."
(else
(and (memq (car specs) (class-precedence-list (car types)))
(lp (cdr specs) (cdr types))))))))))
- (let ((n (length args))
- (types (map class-of args)))
+ (let ((types (map class-of args)))
(let lp ((methods (generic-function-methods gf))
(applicable '()))
(if (null? methods)
@@ -2042,6 +2042,36 @@ function."
(define (toplevel-define! name val)
(module-define! (current-module) name val))
+;;;
+;;; The GOOPS API would have been simpler by introducing keyword formals
+;;; in define-method itself, but in order to align with lambda* and
+;;; define*, we introduce method* and define-method* in parallel to
+;;; method and define-method.
+;;;
+;;; There is some code repetition here. The motivation for that is to
+;;; pay some here in order to speed up loading and compilation of larger
+;;; chunks of GOOPS code as well as to make sure that method*:s are as
+;;; efficient as can be.
+;;;
+;;; A more elegant solution would have been to use something akin to
+;;; Mark H. Weavers macro:
+;;;
+;;; (define-syntax define-method*
+;;; (lambda (x)
+;;; (syntax-case x ()
+;;; ((_ (generic arg-spec ... . tail) body ...)
+;;; (let-values (((required-arg-specs other-arg-specs)
+;;; (break (compose keyword? syntax->datum)
+;;; #'(arg-spec ...))))
+;;; #`(define-method (generic #,@required-arg-specs . rest)
+;;; (apply (lambda* (#,@other-arg-specs . tail)
+;;; body ...)
+;;; rest)))))))
+;;;
+;;; With the current state of the compiler, this results in slower code
+;;; than the implementation below since the apply call isn't eliminated.
+;;;
+
(define-syntax define-method
(syntax-rules (setter)
((_ ((setter name) . args) body ...)
@@ -2064,10 +2094,76 @@ function."
(toplevel-define! 'name (make <generic> #:name 'name)))
(add-method! name (method args body ...))))))
-(define-syntax method
- (lambda (x)
- (define (parse-args args)
- (let lp ((ls args) (formals '()) (specializers '()))
+(define-syntax define-method*
+ (syntax-rules (setter)
+ ((_ ((setter name) . args) body ...)
+ (begin
+ (when (or (not (defined? 'name))
+ (not (is-a? name <accessor>)))
+ (toplevel-define! 'name
+ (ensure-accessor
+ (if (defined? 'name) name #f) 'name)))
+ (add-method! (setter name) (method* args body ...))))
+ ((_ (name . args) body ...)
+ (begin
+ (when (or (not (defined? 'name))
+ (not name))
+ (toplevel-define! 'name (make <generic> #:name 'name)))
+ (add-method! name (method* args body ...))))))
+
+;;; This section of helpers is used by both the method and method* syntax
+;;;
+(eval-when (expand load eval)
+
+ ;; parse-formals METHOD-FORMALS
+ ;;
+ ;; return (FORMALS SPECIALIZERS KEYWORD-FORMALS)
+ ;;
+ ;; FORMALS is the possibly improper list of specializable formals.
+ ;;
+ ;; SPECIALIZERS is a proper list of the corresponding specializers.
+ ;; Its last element corresponds to the cdr of the last element in
+ ;; METHOD-FORMALS such that the possibly improper list corresponding
+ ;; to FORMALS can be obtained by applying cons* to SPECIALIZERS.
+ ;; The reason for handling it like this is that the specializers are
+ ;; each evaluated to their values and therefore *must* be provided
+ ;; by a cons* in the (make <method> ...) expression.
+ ;;
+ ;; KEYWORD_FORMALS is the part of METHOD-FORMALS which starts with a
+ ;; keyword and corresponds to the keyword-syntax of lambda*. These
+ ;; are not specializable (which also corresponds to CLOS
+ ;; functionality).
+ ;;
+ (define (parse-keyword-formals method-formals)
+ (let lp ((ls method-formals) (formals '()) (specializers '()))
+ (syntax-case ls ()
+ (((f s) . rest)
+ (and (identifier? #'f) (identifier? #'s))
+ (lp #'rest
+ (cons #'f formals)
+ (cons #'s specializers)))
+ ((f . rest)
+ (identifier? #'f)
+ (lp #'rest
+ (cons #'f formals)
+ (cons #'<top> specializers)))
+ ((f . rest)
+ (keyword? (syntax->datum #'f))
+ (list (reverse formals)
+ (reverse (cons #'<top> specializers)) ;to be cons*:ed
+ (cons #'f #'rest)))
+ (()
+ (list (reverse formals)
+ (reverse (cons #''() specializers))
+ '())) ;yes, not #''(); used in tests
+ (tail
+ (identifier? #'tail)
+ (list (append (reverse formals) #'tail)
+ (reverse (cons #'<top> specializers))
+ '())))))
+
+ (define (parse-formals method-formals)
+ (let lp ((ls method-formals) (formals '()) (specializers '()))
(syntax-case ls ()
(((f s) . rest)
(and (identifier? #'f) (identifier? #'s))
@@ -2098,43 +2194,87 @@ function."
(and (free-identifier=? #'x id) id)))
(_ #f)))
- (define (compute-procedure formals body)
+ (define (compute-procedure formals keyword-formals body)
(syntax-case body ()
((body0 ...)
- (with-syntax ((formals formals))
- #'(lambda formals body0 ...)))))
-
- (define (->proper args)
- (let lp ((ls args) (out '()))
+ (let ((formals (if (null? keyword-formals)
+ formals
+ (append formals keyword-formals))))
+ (with-syntax ((formals formals))
+ #`(lambda* formals body0 ...))))))
+
+ ;; ->formal-ids FORMALS
+ ;;
+ ;; convert FORMALS into formal-ids format, which is a cell where the
+ ;; car is the list of car:s in FORMALS and the cdr is the cdr of the
+ ;; last cell in FORMALS.
+ ;;
+ ;; The motivation for this format is to determine at low cost if
+ ;; FORMALS is improper or not and to easily be able to generate the
+ ;; corresponding next-method call.
+ ;;
+ (define (->formal-ids formals)
+ (let lp ((ls formals) (out '()))
(syntax-case ls ()
- ((x . xs) (lp #'xs (cons #'x out)))
- (() (reverse out))
- (tail (reverse (cons #'tail out))))))
+ ((x . xs) (lp #'xs (cons #'x out)))
+ (() (cons (reverse out) '()))
+ (tail (cons (reverse out) #'tail)))))
+
+ ;; keyword-formal-ids KEYWORD-FORMALS
+ ;;
+ ;; return a form corresponding to KEYWORD-FORMALS but with
+ ;; identifiers only (keywords removed) The value returned has the
+ ;; formals-ids format as described above.
+ ;;
+ ;; The output is used in the next-method application form.
+ ;;
+ (define (->keyword-formal-ids keyword-formals)
+ (let lp ((ls keyword-formals) (out '()))
+ (syntax-case ls ()
+ (((f val) . rest)
+ (lp #'rest out))
+ ((#:rest f)
+ (cons (reverse out) #'f))
+ ((f . rest)
+ (keyword? (syntax->datum #'f))
+ (lp #'rest out))
+ ((f . rest)
+ (lp #'rest (cons #'f out)))
+ (()
+ (cons (reverse out) '()))
+ (tail
+ (cons (reverse out) #'tail)))))
- (define (compute-make-procedure formals body next-method)
+ (define (compute-make-procedure formals keyword-formals body next-method)
(syntax-case body ()
((body ...)
- (with-syntax ((next-method next-method))
- (syntax-case formals ()
- ((formal ...)
- #'(lambda (real-next-method)
- (lambda (formal ...)
- (let ((next-method (lambda args
- (if (null? args)
- (real-next-method formal ...)
- (apply real-next-method args)))))
- body ...))))
- (formals
- (with-syntax (((formal ...) (->proper #'formals)))
- #'(lambda (real-next-method)
- (lambda formals
- (let ((next-method (lambda args
- (if (null? args)
- (apply real-next-method formal ...)
- (apply real-next-method args)))))
+ (let ((formals (if (null? keyword-formals)
+ formals ;might be improper
+ (append formals keyword-formals)))
+ (formal-ids
+ (if (null? keyword-formals)
+ (->formal-ids formals)
+ (let ((kw-formal-ids (->keyword-formal-ids keyword-formals)))
+ ;; input and result in formals-ids format
+ (cons (append formals (car kw-formal-ids))
+ (cdr kw-formal-ids))))))
+ (with-syntax ((next-method next-method))
+ (syntax-case formals ()
+ (formals
+ #`(lambda (real-next-method)
+ (lambda* formals
+ (let ((next-method
+ (lambda args
+ (if (null? args)
+ #,(if (null? (cdr formal-ids))
+ #`(real-next-method #,@(car formal-ids))
+ #`(apply real-next-method
+ #,@(car formal-ids)
+ #,(cdr formal-ids)))
+ (apply real-next-method args)))))
body ...))))))))))
- (define (compute-procedures formals body)
+ (define (compute-procedures formals keyword-formals body)
;; So, our use of this is broken, because it operates on the
;; pre-expansion source code. It's equivalent to just searching
;; for referent in the datums. Ah well.
@@ -2142,23 +2282,55 @@ function."
(if id
;; return a make-procedure
(values #'#f
- (compute-make-procedure formals body id))
- (values (compute-procedure formals body)
+ (compute-make-procedure formals keyword-formals body id))
+ (values (compute-procedure formals keyword-formals body)
#'#f))))
+ )
+
+(define-syntax method
+ (lambda (x)
+ (syntax-case x ()
+ ((_ formals) #'(method formals (if #f #f)))
+ ((_ formals body0 body1 ...)
+ (with-syntax (((formals (specializer ...))
+ (parse-formals #'formals)))
+ (call-with-values
+ (lambda ()
+ (compute-procedures #'formals
+ '()
+ #'(body0 body1 ...)))
+ (lambda (procedure make-procedure)
+ (with-syntax ((procedure procedure)
+ (make-procedure make-procedure))
+ #`(make <method>
+ #:specializers (cons* specializer ...) ;yes, this
+ ;; The cons* is needed to get the value of each
+ ;; specializer.
+ #:formals 'formals ;might be improper
+ #:body '(body0 body1 ...)
+ #:make-procedure make-procedure
+ #:procedure procedure)))))))))
+(define-syntax method*
+ (lambda (x)
(syntax-case x ()
- ((_ args) #'(method args (if #f #f)))
- ((_ args body0 body1 ...)
- (with-syntax (((formals (specializer ...)) (parse-args #'args)))
+ ((_ formals) #'(method formals (if #f #f)))
+ ((_ formals body0 body1 ...)
+ (with-syntax (((formals (specializer ...) keyword-formals)
+ (parse-keyword-formals #'formals)))
(call-with-values
(lambda ()
- (compute-procedures #'formals #'(body0 body1 ...)))
+ (compute-procedures #'formals
+ #'keyword-formals
+ #'(body0 body1 ...)))
(lambda (procedure make-procedure)
(with-syntax ((procedure procedure)
(make-procedure make-procedure))
- #'(make <method>
+ #`(make <method>
#:specializers (cons* specializer ...)
- #:formals 'formals
+ #:formals (if (null? 'keyword-formals)
+ 'formals ;might be improper
+ (append 'formals 'keyword-formals))
#:body '(body0 body1 ...)
#:make-procedure make-procedure
#:procedure procedure)))))))))
^ permalink raw reply related [flat|nested] 3+ messages in thread* Re: Keywords in GOOPS methods v2
2024-11-24 14:40 Keywords in GOOPS methods v2 Mikael Djurfeldt
@ 2024-11-24 14:43 ` Mikael Djurfeldt
2024-11-24 17:54 ` Mikael Djurfeldt
0 siblings, 1 reply; 3+ messages in thread
From: Mikael Djurfeldt @ 2024-11-24 14:43 UTC (permalink / raw)
To: guile-user, guile-devel, Ludovic Courtès, Andy Wingo
Cc: Jan Nieuwenhuizen, Tomas Volf, Maxime Devos, David Pirotte
Guile maintainers might want to consider if we should time this kind of
change in the API with a particular release. For my part, I think we could
just add it.
On Sun, Nov 24, 2024 at 3:40 PM Mikael Djurfeldt <mikael@djurfeldt.com>
wrote:
> This is my second attempt at introducing keyword aware methods in GOOPS.
>
> I was split but finally decided to go with keeping keyword non-aware
> define-method and method and introducing keyword aware new syntax method*
> and define-method*. Arguments are:
>
> 1. It preserves simplicity in method and define-method such that other
> implementations (like guile-hoot) can choose to only define these (and
> possibly provide something like Mark's macro doe define-method*).
> 2. It aligns with lambda* and define*.
> 3. It is somewhat better at protecting backward compatibility.
> 4. It preserves the option to also in the internal implementation use
> something like Mark's macro once this gives equal performance.
>
> I've also committed these changes to
>
> https://github.com/mdjurfeldt/guile/tree/goops-keyword
>
> I'm going to start documenting this now and will then commit it to the
> Guile repo.
>
> Best regards,
> Mikael
>
>
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: Keywords in GOOPS methods v2
2024-11-24 14:43 ` Mikael Djurfeldt
@ 2024-11-24 17:54 ` Mikael Djurfeldt
0 siblings, 0 replies; 3+ messages in thread
From: Mikael Djurfeldt @ 2024-11-24 17:54 UTC (permalink / raw)
To: guile-user, guile-devel, Ludovic Courtès, Andy Wingo
Cc: Jan Nieuwenhuizen, Tomas Volf, Maxime Devos, David Pirotte
[-- Attachment #1: Type: text/plain, Size: 1524 bytes --]
Ah... I forgot to complete parse-keyword-formals, which is currently only
rudimentary and doesn't compose the correct argument list for (next-method).
There will be a version 3...
On Sun, Nov 24, 2024 at 3:43 PM Mikael Djurfeldt <mikael@djurfeldt.com>
wrote:
> Guile maintainers might want to consider if we should time this kind of
> change in the API with a particular release. For my part, I think we could
> just add it.
>
> On Sun, Nov 24, 2024 at 3:40 PM Mikael Djurfeldt <mikael@djurfeldt.com>
> wrote:
>
>> This is my second attempt at introducing keyword aware methods in GOOPS.
>>
>> I was split but finally decided to go with keeping keyword non-aware
>> define-method and method and introducing keyword aware new syntax method*
>> and define-method*. Arguments are:
>>
>> 1. It preserves simplicity in method and define-method such that other
>> implementations (like guile-hoot) can choose to only define these (and
>> possibly provide something like Mark's macro doe define-method*).
>> 2. It aligns with lambda* and define*.
>> 3. It is somewhat better at protecting backward compatibility.
>> 4. It preserves the option to also in the internal implementation use
>> something like Mark's macro once this gives equal performance.
>>
>> I've also committed these changes to
>>
>> https://github.com/mdjurfeldt/guile/tree/goops-keyword
>>
>> I'm going to start documenting this now and will then commit it to the
>> Guile repo.
>>
>> Best regards,
>> Mikael
>>
>>
[-- Attachment #2: Type: text/html, Size: 2371 bytes --]
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2024-11-24 17:54 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-11-24 14:40 Keywords in GOOPS methods v2 Mikael Djurfeldt
2024-11-24 14:43 ` Mikael Djurfeldt
2024-11-24 17:54 ` Mikael Djurfeldt
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).