+#+openmcl
+(defun compute-class-precedence-list (class)
+ ;; safe to call this in openmcl
+ (class-precedence-list class))
+
+#-(or sbcl cmu)
+(defmethod compute-slots ((class standard-db-class))
+ "Need to sort order of class slots so they are the same across
+implementations."
+ (let ((slots (call-next-method))
+ desired-sequence
+ output-slots)
+ (dolist (c (compute-class-precedence-list class))
+ (dolist (s (class-direct-slots c))
+ (let ((name (slot-definition-name s)))
+ (unless (find name desired-sequence)
+ (push name desired-sequence)))))
+ (dolist (desired desired-sequence)
+ (let ((slot (find desired slots :key #'slot-definition-name)))
+ (assert slot)
+ (push slot output-slots)))
+ output-slots))
+
+(defun compute-lisp-type-from-slot-specification (slotd specified-type)
+ "Computes the Lisp type for a user-specified type. Needed for OpenMCL
+which does type checking before storing a value in a slot."
+ #-openmcl (declare (ignore slotd))
+ ;; This function is called after the base compute-effective-slots is called.
+ ;; OpenMCL sets the type-predicate based on the initial value of the slots type.
+ ;; so we have to override the type-predicates here
+ (cond
+ ((consp specified-type)
+ (cond
+ ((and (symbolp (car specified-type))
+ (string-equal (symbol-name (car specified-type)) "string"))
+ #+openmcl (setf (slot-value slotd 'ccl::type-predicate) 'stringp)
+ 'string)
+ (t
+ #+openmcl (setf (slot-value slotd 'ccl::type-predicate) 'ccl:true)
+ specified-type)))
+ #+openmcl
+ ((null specified-type)
+ ;; setting this here is not enough since openmcl later sets the
+ ;; type-predicate to ccl:false. So, have to check slots again
+ ;; in finalize-inheritance
+ #+openmcl (setf (slot-value slotd 'ccl::type-predicate) 'ccl:true)
+ t)
+ (t
+ ;; This can be improved for OpenMCL to set a more specific type
+ ;; predicate based on the value specified-type
+ #+openmcl (setf (slot-value slotd 'ccl::type-predicate) 'ccl:true)
+ specified-type)))
+