X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=equal.lisp;h=eb9474ce5ec7f7deb2e9ffb2355181ee43c152c6;hp=09ff47a29cbb00428c49045778ccc2aa54719bb0;hb=90225d9ba12f7a9116bcc923afdaf6e76a8c6728;hpb=152fd9dc7d5a0fb8079f3b18ecafff6aeb836a75 diff --git a/equal.lisp b/equal.lisp index 09ff47a..eb9474c 100644 --- a/equal.lisp +++ b/equal.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: equal.lisp,v 1.13 2003/04/29 04:56:58 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -17,8 +17,7 @@ ;;;; ************************************************************************* -(in-package :kmrcl) -(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) +(in-package #:kmrcl) (defun generalized-equal (obj1 obj2) @@ -37,7 +36,7 @@ (complex (and (generalized-equal (realpart obj1) (realpart obj2)) (generalized-equal (imagpart obj1) (imagpart obj2)))) - (standard-xstructure + (structure-object (generalized-equal-fielded-object obj1 obj2)) (standard-object (generalized-equal-fielded-object obj1 obj2)) @@ -92,12 +91,12 @@ #+(or allegro cmu lispworks sbcl scl) (mapcar #'kmr-mop:slot-definition-name (kmr-mop:class-slots (kmr-mop:find-class c-name))) - #+mcl + #+(and mcl (not openmcl)) (let* ((class (find-class c-name nil))) (when (typep class 'standard-class) (nconc (mapcar #'car (ccl:class-instance-slots class)) (mapcar #'car (ccl:class-class-slots class))))) - #-(or allegro lispworks cmu mcl sbcl scl) + #-(or allegro lispworks cmu mcl sbcl scl openmcl) (error "class-slot-names is not defined on this platform") ) @@ -112,7 +111,8 @@ (kernel:dd-slots (kernel:layout-info (kernel:class-layout (find-class s-name))))) - #+mcl (let* ((sd (gethash s-name ccl::%defstructs%)) + #+(and mcl (not openmcl)) + (let* ((sd (gethash s-name ccl::%defstructs%)) (slots (if sd (ccl::sd-slots sd)))) (mapcar #'car (if (symbolp (caar slots)) slots (cdr slots)))) #-(or allegro lispworks cmu sbcl scl mcl)