mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

Distinguish between lambda and lambda* in generated procedures

Browse source 
* 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.
This commit is contained in:
Mikael Djurfeldt 2024-11-24 18:09:40 +01:00
parent 05de7e3e61
commit 2d18afe5ac
1 changed files with 47 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

81
module/oop/goops.scm
View file

@ -2197,21 +2197,22 @@ function."
(define (compute-procedure formals keyword-formals body) (define (compute-procedure formals keyword-formals body)
(syntax-case body () (syntax-case body ()
((body0 ...) ((body0 ...)
(let ((formals (if (null? keyword-formals) (if (null? keyword-formals)
formals (with-syntax ((formals formals))
(append formals keyword-formals)))) #'(lambda formals body0 ...))
(with-syntax ((formals formals)) (let ((formals (append formals keyword-formals)))
#`(lambda* formals body0 ...)))))) (with-syntax ((formals formals))
#'(lambda* formals body0 ...)))))))
;; ->formal-ids FORMALS ;; ->formal-ids FORMALS
;; ;;
;; convert FORMALS into formal-ids format, which is a cell where the ;; 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 ;; 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 ;; The motivation for this format is to easily determine if FORMALS
;; FORMALS is improper or not and to easily be able to generate the ;; is improper or not in order to generate the corresponding
;; corresponding next-method call. ;; next-method call.
;; ;;
(define (->formal-ids formals) (define (->formal-ids formals)
(let lp ((ls formals) (out '())) (let lp ((ls formals) (out '()))
@ -2248,31 +2249,43 @@ function."
(define (compute-make-procedure formals keyword-formals body next-method) (define (compute-make-procedure formals keyword-formals body next-method)
(syntax-case body () (syntax-case body ()
((body ...) ((body ...)
(let ((formals (if (null? keyword-formals) (call-with-values
formals ;might be improper (lambda ()
(append formals keyword-formals))) (if (null? keyword-formals)
(formal-ids (values #'lambda
(if (null? keyword-formals) formals
(->formal-ids formals) (->formal-ids formals))
(let ((kw-formal-ids (->keyword-formal-ids keyword-formals))) (values #'lambda*
;; input and result in formals-ids format (append formals keyword-formals)
(cons (append formals (car kw-formal-ids)) (let ((keyword-formal-ids
(cdr kw-formal-ids)))))) ;; filter out the identifiers
(with-syntax ((next-method next-method)) (->keyword-formal-ids keyword-formals)))
(syntax-case formals () ;; input and result in formals-ids format
(formals (cons (append formals (car keyword-formal-ids))
#`(lambda (real-next-method) (cdr keyword-formal-ids))))))
(lambda* formals (lambda (lambda-type formals formal-ids)
(let ((next-method (with-syntax ((next-method next-method))
(lambda args (syntax-case formals ()
(if (null? args) (formals
#,(if (null? (cdr formal-ids)) #`(lambda (real-next-method)
#`(real-next-method #,@(car formal-ids)) (#,lambda-type ;lambda or lambda*
#`(apply real-next-method formals
#,@(car formal-ids) (let ((next-method
#,(cdr formal-ids))) (lambda args
(apply real-next-method args))))) (if (null? args)
body ...)))))))))) ;; 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) (define (compute-procedures formals keyword-formals body)
;; So, our use of this is broken, because it operates on the ;; So, our use of this is broken, because it operates on the