;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2003
;;;;
-;;;; $Id: mop.lisp 8573 2004-01-29 23:30:50Z kevin $
+;;;; $Id$
+;;;;
+;;;; This file imports MOP symbols into the CLSQL-MOP package and then
+;;;; re-exports into CLSQL-SYS them to hide differences in
+;;;; MOP implementations.
;;;;
;;;; This file was extracted from the KMRCL utilities
;;;; *************************************************************************
-;;; This file imports MOP symbols into the USQL-MOP package and then
-;;; re-exports into CLSQL-USQL-SYS them to hide differences in
-;;; MOP implementations.
-
(in-package #:clsql-sys)
#+lispworks
(declare (ignore metaclass slot-name))
)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defclass %slot-order-test-class ()
+ ((a)
+ (b)))
+ (finalize-inheritance (find-class '%slot-order-test-class))
+ (let ((slots (class-slots (find-class '%slot-order-test-class))))
+ (ecase (slot-definition-name (first slots))
+ (a)
+ (b (pushnew :mop-slot-order-reversed cl:*features*)))))
+
+(defun ordered-class-slots (class)
+ #+mop-slot-order-reversed (reverse (class-slots class))
+ #-mop-slot-order-reversed (class-slots class))
+
+;; Lispworks has symbol for slot rather than the slot instance
+(defun %svuc-slot-name (slot)
+ #+lispworks slot
+ #-lispworks (slot-definition-name slot))
+
+(defun %svuc-slot-object (slot class)
+ (declare (ignorable class))
+ #+lispworks (clos:find-slot-definition slot class)
+ #-lispworks slot)
+