[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