[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 04/07: Distinguish between lambda and lambda* in generat
From: |
Mikael Djurfeldt |
Subject: |
[Guile-commits] 04/07: Distinguish between lambda and lambda* in generated procedures |
Date: |
Mon, 25 Nov 2024 15:54:17 -0500 (EST) |
mdj pushed a commit to branch main
in repository guile.
commit 2d18afe5accef402ceb477ac585a46871570dd23
Author: Mikael Djurfeldt <mikael@djurfeldt.com>
AuthorDate: Sun Nov 24 18:09:40 2024 +0100
Distinguish between lambda and lambda* in generated procedures
* module/oop/goops (compute-procedure, compute-make-procedure): Emit
lambda or lambda* as appropriate. This doesn't matter now since all
will boil down to lambda-case, but to be future-proof...
Also add some clarifying comments.
---
module/oop/goops.scm | 81 ++++++++++++++++++++++++++++++----------------------
1 file changed, 47 insertions(+), 34 deletions(-)
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 01bf1612e..5ef39d17f 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -2197,21 +2197,22 @@ function."
(define (compute-procedure formals keyword-formals body)
(syntax-case body ()
((body0 ...)
- (let ((formals (if (null? keyword-formals)
- formals
- (append formals keyword-formals))))
- (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.
+ ;; last cell in FORMALS, i.e. the final tail.
;;
- ;; 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.
+ ;; 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 '()))
@@ -2248,31 +2249,43 @@ function."
(define (compute-make-procedure formals keyword-formals body next-method)
(syntax-case body ()
((body ...)
- (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 ...))))))))))
+ (call-with-values
+ (lambda ()
+ (if (null? keyword-formals)
+ (values #'lambda
+ formals
+ (->formal-ids formals))
+ (values #'lambda*
+ (append formals keyword-formals)
+ (let ((keyword-formal-ids
+ ;; filter out the identifiers
+ (->keyword-formal-ids keyword-formals)))
+ ;; input and result in formals-ids format
+ (cons (append formals (car keyword-formal-ids))
+ (cdr keyword-formal-ids))))))
+ (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
- [Guile-commits] branch main updated (c51fcfffb -> a3c77cb8d), Mikael Djurfeldt, 2024/11/25
- [Guile-commits] 02/07: GOOPS: Introduce new forms method* and define-method*, Mikael Djurfeldt, 2024/11/25
- [Guile-commits] 03/07: Remove method slot keyword-formals? introduced in 765f1d49, Mikael Djurfeldt, 2024/11/25
- [Guile-commits] 04/07: Distinguish between lambda and lambda* in generated procedures,
Mikael Djurfeldt <=
- [Guile-commits] 05/07: Correctly pass on keyword arguments actually present in args list, Mikael Djurfeldt, 2024/11/25
- [Guile-commits] 06/07: Document method* and define-method*, Mikael Djurfeldt, 2024/11/25
- [Guile-commits] 01/07: GOOPS: Add support for keyword arguments in methods, Mikael Djurfeldt, 2024/11/25
- [Guile-commits] 07/07: Update NEWS, Mikael Djurfeldt, 2024/11/25