Add define-method*

parent 1bbd9ced
......@@ -83,6 +83,7 @@ SOURCES = \
pubstrate/webapp/views.scm \
pubstrate/contrib/base32.scm \
pubstrate/contrib/base64.scm \
pubstrate/contrib/define-method-star.scm \
pubstrate/contrib/html.scm \
pubstrate/contrib/mime-types.scm \
pubstrate/contrib/gcrypt.scm \
......
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public License
;;; as published by the Free Software Foundation, either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public License
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; This particular module is originally by Mark Weaver, and is LGPLv3
;;; or later, unlike the rest of Pubstrate.
(define-module (pubstrate contrib define-method-star)
#:use-module (oop goops)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:export (define-method*))
(define-syntax define-method*
(lambda (x)
(syntax-case x ()
((_ (generic arg-spec ... . tail) body ...)
(let-values (((required-arg-specs other-arg-specs)
(break (compose keyword? syntax->datum)
#'(arg-spec ...))))
#`(define-method (generic #,@required-arg-specs . rest)
(apply (lambda* (#,@other-arg-specs . tail)
body ...)
rest)))))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment