* Keywords in GOOPS methods v2
@ 2024-11-24 14:40 Mikael Djurfeldt
2024-11-24 14:43 ` Mikael Djurfeldt
2024-11-25 10:28 ` Keywords in GOOPS methods v3 Mikael Djurfeldt
0 siblings, 2 replies; 7+ 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] 7+ 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
2024-11-24 22:20 ` David Pirotte
2024-11-25 10:28 ` Keywords in GOOPS methods v3 Mikael Djurfeldt
1 sibling, 2 replies; 7+ 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] 7+ messages in thread
* Re: Keywords in GOOPS methods v2
2024-11-24 14:43 ` Mikael Djurfeldt
@ 2024-11-24 17:54 ` Mikael Djurfeldt
2024-11-24 22:20 ` David Pirotte
1 sibling, 0 replies; 7+ 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] 7+ messages in thread
* Re: Keywords in GOOPS methods v2
2024-11-24 14:43 ` Mikael Djurfeldt
2024-11-24 17:54 ` Mikael Djurfeldt
@ 2024-11-24 22:20 ` David Pirotte
1 sibling, 0 replies; 7+ messages in thread
From: David Pirotte @ 2024-11-24 22:20 UTC (permalink / raw)
To: Mikael Djurfeldt
Cc: guile-user, guile-devel, Ludovic Courtès, Andy Wingo,
Jan Nieuwenhuizen, Tomas Volf, Maxime Devos
[-- Attachment #1: Type: text/plain, Size: 425 bytes --]
Hi Mikael,
> 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.
1+
imo as well, there is no need to wait for a particular release [*]
David
[*] especially since you said in another email that you plan to add
method* and define-method* and leave the existing method and
define-method unchanged.
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]
^ permalink raw reply [flat|nested] 7+ messages in thread
* Keywords in GOOPS methods v3
2024-11-24 14:40 Keywords in GOOPS methods v2 Mikael Djurfeldt
2024-11-24 14:43 ` Mikael Djurfeldt
@ 2024-11-25 10:28 ` Mikael Djurfeldt
2024-11-25 20:56 ` Mikael Djurfeldt
1 sibling, 1 reply; 7+ messages in thread
From: Mikael Djurfeldt @ 2024-11-25 10:28 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: Type: text/plain, Size: 420 bytes --]
This is the third attempt at introducing keyword aware methods in GOOPS.
What is new in v3 is that keyword arguments and default parameters to
keyword arguments are handled correctly when using (next-method). Now only
those keyword arguments actually present in a call get forwarded to the
next-method.
I've also committed these changes to
https://github.com/mdjurfeldt/guile/tree/goops-keyword
Best regards,
Mikael
[-- Attachment #2: goops-kw-patch-3.patch --]
[-- Type: text/x-patch, Size: 16281 bytes --]
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 8ed68694c..12644eba5 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,135 @@ 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 ...)))))
+ (if (null? keyword-formals)
+ (with-syntax ((formals formals))
+ #'(lambda formals body0 ...))
+ (let ((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, i.e. the final tail.
+ ;;
+ ;; The motivation for this format is to easily determine if FORMALS
+ ;; is improper or not in order 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)))
+ (() (cons (reverse out) '()))
+ (tail (cons (reverse out) #'tail)))))
+
+ ;; compute-keyword-formal-ids FORMALS KEYWORD-FORMALS
+ ;;
+ ;; The main purpose of this beast is to compute the argument list
+ ;; for the actual next-method call for the case where the user calls
+ ;; (next-method). It is invoked in the case where we have keyword
+ ;; formals. Here we have to treat keyword arguments in a special way
+ ;; since we, similar to CLOS, only want to pass on the keyword
+ ;; arguments that were present in the call. We capture those using
+ ;; the rest argument. If not present, we introduce a rest formal.
+ ;;
+ ;; FORMALS is the non-keyword part of the formal arguments.
+ ;; KEYWORD-FORMALS is the part of the formal arguments from the
+ ;; first keyword.
+ ;;
+ ;; return three values:
+ ;;
+ ;; 1. #'lambda
+ ;; 2. the complete formals list
+ ;; 3. the argument list for next-method in formals-ids format as
+ ;; described above (proper list in CAR, tail in CDR)
+ ;;
+ (define (compute-keyword-formal-ids formals keyword-formals)
+ (define (result formals formal-ids)
+ (values #'lambda* formals formal-ids))
+
+ (define (lp-key ls formals formal-ids)
+ (syntax-case ls ()
+ ((#:rest f)
+ (identifier? #'f)
+ (result (append (reverse formals) #'f)
+ (cons (reverse formal-ids) #'f)))
+ (()
+ ;; No rest formal is present, so we need to introduce one.
+ (let ((rest-formal (car (generate-temporaries '(rest)))))
+ (result (append (reverse formals) rest-formal)
+ (cons (reverse formal-ids) rest-formal))))
+ ((f . rest)
+ (lp-key #'rest
+ (cons #'f formals) ;keep
+ formal-ids)) ;filter away
+ (tail
+ (result (append (reverse formals) #'tail)
+ (cons (reverse formal-ids) #'tail)))))
- (define (->proper args)
- (let lp ((ls args) (out '()))
+ (let ((reversed-formals (reverse formals)))
+ (let lp ((ls keyword-formals)
+ (formals reversed-formals)
+ (formal-ids reversed-formals))
(syntax-case ls ()
- ((x . xs) (lp #'xs (cons #'x out)))
- (() (reverse out))
- (tail (reverse (cons #'tail out))))))
+ (((f val) . rest)
+ (lp #'rest (cons #'(f val) formals) (cons #'f formal-ids)))
+ ((#:optional . rest)
+ (lp #'rest (cons #:optional formals) formal-ids))
+ ((#:key . rest)
+ (lp-key #'rest (cons #:key formals) formal-ids))
+ ((#:rest f)
+ (identifier? #'f)
+ (result (append (reverse formals) #'f)
+ (cons (reverse formal-ids) #'f)))
+ ((f . rest)
+ (lp #'rest (cons #'f formals) (cons #'f formal-ids)))
+ (()
+ (result (reverse formals) (cons (reverse formal-ids) '())))
+ (tail
+ (result (append (reverse formals) #'tail)
+ (cons (reverse formal-ids) #'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)))))
- body ...))))))))))
-
- (define (compute-procedures formals body)
+ (call-with-values
+ (lambda ()
+ (if (null? keyword-formals)
+ (values #'lambda
+ formals
+ (->formal-ids formals))
+ (compute-keyword-formal-ids formals keyword-formals)))
+ (lambda (lambda-type formals formal-ids)
+ (with-syntax ((next-method next-method))
+ (syntax-case formals ()
+ (formals
+ #`(lambda (real-next-method)
+ (#,lambda-type ;lambda or lambda*
+ formals
+ (let ((next-method
+ (lambda args
+ (if (null? args)
+ ;; We have (next-method) and need to
+ ;; pass on the arguments to the method.
+ #,(if (null? (cdr formal-ids))
+ ;; proper list of identifiers
+ #`(real-next-method
+ #,@(car formal-ids))
+ ;; last identifier is a rest list
+ #`(apply real-next-method
+ #,@(car formal-ids)
+ #,(cdr formal-ids)))
+ ;; user passes arguments to next-method
+ (apply real-next-method args)))))
+ 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 +2330,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] 7+ messages in thread* Re: Keywords in GOOPS methods v3
2024-11-25 10:28 ` Keywords in GOOPS methods v3 Mikael Djurfeldt
@ 2024-11-25 20:56 ` Mikael Djurfeldt
2024-11-25 22:51 ` David Pirotte
0 siblings, 1 reply; 7+ messages in thread
From: Mikael Djurfeldt @ 2024-11-25 20:56 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: 582 bytes --]
I just pushed this to Savannah.
On Mon, Nov 25, 2024 at 11:28 AM Mikael Djurfeldt <mikael@djurfeldt.com>
wrote:
> This is the third attempt at introducing keyword aware methods in GOOPS.
>
> What is new in v3 is that keyword arguments and default parameters to
> keyword arguments are handled correctly when using (next-method). Now only
> those keyword arguments actually present in a call get forwarded to the
> next-method.
>
> I've also committed these changes to
>
> https://github.com/mdjurfeldt/guile/tree/goops-keyword
>
> Best regards,
> Mikael
>
>
[-- Attachment #2: Type: text/html, Size: 1067 bytes --]
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: Keywords in GOOPS methods v3
2024-11-25 20:56 ` Mikael Djurfeldt
@ 2024-11-25 22:51 ` David Pirotte
0 siblings, 0 replies; 7+ messages in thread
From: David Pirotte @ 2024-11-25 22:51 UTC (permalink / raw)
To: Mikael Djurfeldt
Cc: guile-user, guile-devel, Ludovic Courtès, Andy Wingo,
Jan Nieuwenhuizen, Tomas Volf, Maxime Devos
[-- Attachment #1: Type: text/plain, Size: 107 bytes --]
Hi Mikael,
> I just pushed this to Savannah.
Excellent!
Thanks for having worked on this.
David
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2024-11-25 22:51 UTC | newest]
Thread overview: 7+ 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
2024-11-24 22:20 ` David Pirotte
2024-11-25 10:28 ` Keywords in GOOPS methods v3 Mikael Djurfeldt
2024-11-25 20:56 ` Mikael Djurfeldt
2024-11-25 22:51 ` David Pirotte
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).