summaryrefslogtreecommitdiff
path: root/module/oop
diff options
context:
space:
mode:
authorMikael Djurfeldt <mikael@djurfeldt.com>2024-11-24 18:09:40 +0100
committerMikael Djurfeldt <mikael@djurfeldt.com>2024-11-25 21:47:53 +0100
commit2d18afe5accef402ceb477ac585a46871570dd23 (patch)
treeffee8569e65bb513004221abc1c32e4479fd6dee /module/oop
parent05de7e3e6100a065599260e6212329b23da1fa64 (diff)
downloadguile-2d18afe5accef402ceb477ac585a46871570dd23.tar.gz
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.
Diffstat (limited to 'module/oop')
-rw-r--r--module/oop/goops.scm81
1 files 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