[armedbear-cvs] r14003 - trunk/abcl/src/org/armedbear/lisp
rschlatte at common-lisp.net
rschlatte at common-lisp.net
Fri Jul 13 14:07:28 UTC 2012
Author: rschlatte
Date: Fri Jul 13 07:07:27 2012
New Revision: 14003
Log:
Eliminate once-only-used function
Modified:
trunk/abcl/src/org/armedbear/lisp/clos.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp Thu Jul 12 02:25:37 2012 (r14002)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp Fri Jul 13 07:07:27 2012 (r14003)
@@ -870,9 +870,6 @@
(maybe-finalize-class-subtree class)
(values))
-(defun canonical-slot-name (canonical-slot)
- (getf canonical-slot :name))
-
(defvar *extensible-built-in-classes*
(list (find-class 'sequence)
(find-class 'java:java-object)))
@@ -2879,11 +2876,13 @@
;;; Class definition
(defun check-duplicate-slots (slots)
- (dolist (s1 slots)
- (let ((name1 (canonical-slot-name s1)))
- (dolist (s2 (cdr (memq s1 slots)))
- (when (eq name1 (canonical-slot-name s2))
- (error 'program-error "Duplicate slot ~S" name1))))))
+ (flet ((canonical-slot-name (canonical-slot)
+ (getf canonical-slot :name)))
+ (dolist (s1 slots)
+ (let ((name1 (canonical-slot-name s1)))
+ (dolist (s2 (cdr (memq s1 slots)))
+ (when (eq name1 (canonical-slot-name s2))
+ (error 'program-error "Duplicate slot ~S" name1)))))))
(defun check-duplicate-default-initargs (initargs)
(let ((names ()))
More information about the armedbear-cvs
mailing list