diff options
Diffstat (limited to 'oop/goops/old-define-method.scm')
-rw-r--r-- | oop/goops/old-define-method.scm | 60 |
1 files changed, 0 insertions, 60 deletions
diff --git a/oop/goops/old-define-method.scm b/oop/goops/old-define-method.scm deleted file mode 100644 index 3469dc9bb..000000000 --- a/oop/goops/old-define-method.scm +++ /dev/null @@ -1,60 +0,0 @@ -;;; installed-scm-file - -;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. -;;;; -;;;; This library 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 2.1 of the License, or (at your option) any later version. -;;;; -;;;; This library 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 library; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -;;;; - - -(define-module (oop goops old-define-method) - :use-module (oop goops) - :export (define-method) - :no-backtrace - ) - -(define define-method - (procedure->memoizing-macro - (lambda (exp env) - (let ((name (cadr exp))) - (if (and (pair? name) - (eq? (car name) 'setter) - (pair? (cdr name)) - (symbol? (cadr name)) - (null? (cddr name))) - (let ((name (cadr name))) - (cond ((not (symbol? name)) - (goops-error "bad method name: ~S" name)) - ((defined? name env) - `(begin - ;; *fixme* Temporary hack for the current module system - (if (not ,name) - (define-accessor ,name)) - (add-method! (setter ,name) (method ,@(cddr exp))))) - (else - `(begin - (define-accessor ,name) - (add-method! (setter ,name) (method ,@(cddr exp))))))) - (cond ((not (symbol? name)) - (goops-error "bad method name: ~S" name)) - ((defined? name env) - `(begin - ;; *fixme* Temporary hack for the current module system - (if (not ,name) - (define-generic ,name)) - (add-method! ,name (method ,@(cddr exp))))) - (else - `(begin - (define-generic ,name) - (add-method! ,name (method ,@(cddr exp))))))))))) |