[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
GOOPS: define-method* with extended lambda-list-syntax?
From: |
Anders Vinjar |
Subject: |
GOOPS: define-method* with extended lambda-list-syntax? |
Date: |
10 Apr 2003 11:23:02 +0200 |
User-agent: |
Gnus/5.0808 (Gnus v5.8.8) XEmacs/21.4 (Honest Recruiter) |
A question for anyone having a better knowledge than me about
development around GOOPS.
In translating a piece of CLTL to Guile, I would need a
procedure/macro define-method* which gives access to extended
lambda-list syntax (ie. with #:optional #:key etc) parameters.
Q: is there something like this available anywhere already?
Q2: if not, is having this in CLOS a big design-flaw, making my
attempts here just silly?
I did an attempt at building a define-method* macro, which sort
of works, but it seems very inefficient. Im sure there are flaws
with it i havent ran across yet because of lack of knowledge.
(define-method* (f (x <real>) (y <top>) #:optional z)
'real-top)
expands into 2 calls on add-method! - one with specialiser for
(list <real> <top>)
- the other for
(list <real> <top> <top>)
The procedure-slot is the same for both methods.
guile> (generic-function-methods f)
=> (#<<method> (<real> <top>) 808c060> #<<method> (<real> <top> <top>) 808c090>)
Heres the define-method* macro ive put together this far. (It
uses a procedure parse-lambda-list which just divides the various
elements of an extended lambda list into sublists. Limiting to
#:optional-arguments for now while testing.)
(defmacro define-method* (name-pars . body)
(let ((name (car name-pars))
(pars (cdr name-pars)))
(multiple-value-bind
(reqs opts rest keys aok? auxs)
(parse-lambda-list pars)
(let* ((specsr (map (lambda (y) (if (list? y) (cadr y)))
reqs))
(specs (append specsr
(map (lambda (y)
(if (cadr y)
(class-name (class-of (cadr y)))
'<top>))
opts)))
(llist (append (map (lambda (y) (if (list? y) (car y) y)) reqs)
(list #:optional)
opts)))
(cond ((defined? name)
`(begin
(if (not ,name)
(define-generic ,name))
(add-method! ,name
(make-method (list ,@specs)
(lambda* ,llist ,@body)))
(add-method! ,name
(make-method (list ,@specsr)
(lambda* ,llist ,@body)))))
(else
`(begin
(define-generic ,name)
(add-method! ,name
(make-method (list ,@specs)
(lambda* ,llist ,@body)))
(add-method! ,name
(make-method (list ,@specsr)
(lambda* ,llist ,@body))))))))))
(define-method* (f (x <real>) (y <integer>) #:optional z)
(list 'real-integer z))
(define-method* (f (x <real>) (y <top>) #:optional z)
(list 'real-top z))
(define-method* (f (x <real>) (y <real>) #:optional z)
(list 'real-real z))
--
Anders Vinjar - NoTAM
- GOOPS: define-method* with extended lambda-list-syntax?,
Anders Vinjar <=