summaryrefslogtreecommitdiff
path: root/oop/goops/old-define-method.scm
diff options
context:
space:
mode:
Diffstat (limited to 'oop/goops/old-define-method.scm')
-rw-r--r--oop/goops/old-define-method.scm60
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)))))))))))