(defun describe-db-layout (class)
(flet ((not-db-col (col)
- (not (member (nth 2 col) '(nil :base :key))))
+ (not (member (nth 2 col) '(nil :base :key))))
(frob-slot (slot)
- (let ((type (slot-value slot 'type)))
+ (let ((type (slot-definition-type slot)))
(if (eq type t)
(setq type nil))
(list (slot-value slot 'name)
(defun parse-db-info (db-info-list)
(destructuring-bind
(&key join-class home-key key-join foreign-key (delete-rule nil)
- (target-slot nil) (retrieval :deferred) (set nil))
+ (target-slot nil) (retrieval :deferred) (set t))
db-info-list
(let ((ih (make-hash-table :size 6)))
(if join-class
(car list)
list))
+(defvar *impl-type-attrib-name* #-clisp 'type #+clisp 'clos::$type)
+
(defmethod compute-effective-slot-definition ((class standard-db-class)
#+kmr-normal-cesd slot-name
direct-slots)
(null (specified-type dsd)))
(setf (specified-type dsd)
(slot-definition-type dsd))
- (setf (slot-value dsd 'type)
- (compute-lisp-type-from-slot-specification
- dsd (slot-definition-type dsd))))
+ (setf #-clisp (slot-value dsd 'type)
+ #+clisp (slot-definition-type dsd)
+ (compute-lisp-type-from-slot-specification
+ dsd (slot-definition-type dsd))))
(let ((esd (call-next-method)))
(typecase dsd
(t
(let ((type-predicate #+openmcl (slot-value esd 'ccl::type-predicate)))
#-openmcl (declare (ignore type-predicate))
- (change-class esd 'view-class-effective-slot-definition
- #+allegro :name
- #+allegro (slot-definition-name dsd))
+ #-clisp (change-class esd 'view-class-effective-slot-definition
+ #+allegro :name
+ #+allegro (slot-definition-name dsd))
#+openmcl (setf (slot-value esd 'ccl::type-predicate)
type-predicate))