[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)

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)))
          (reqs opts rest keys aok? auxs)
        (parse-lambda-list pars)
      (let* ((specsr (map (lambda (y) (if (list? y) (cadr y)))
             (specs (append specsr
                            (map (lambda (y)
                                   (if (cadr y)
                                     (class-name (class-of (cadr y)))
             (llist (append (map (lambda (y) (if (list? y) (car y) y)) reqs)
                            (list #:optional)
        (cond ((defined? name)
                 (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)))))
                 (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

reply via email to

[Prev in Thread] Current Thread [Next in Thread]