X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;ds=sidebyside;f=sql%2Fmetaclasses.lisp;h=a086288198f03161cfe8ca33cfd0f2a38f1e0054;hb=b956c76026d39e3aaa065e64a100e3ad16d03cd5;hp=7980e325edcf6737aefb3d2f3ec5b7e93a9db9ea;hpb=d0695ffb828519fade3aa5166236812e6144975b;p=clsql.git diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp index 7980e32..a086288 100644 --- a/sql/metaclasses.lisp +++ b/sql/metaclasses.lisp @@ -165,11 +165,13 @@ (nth (1+ pos) list))))) (mapcar #'extract keys))) +(defvar *impl-type-attrib-name* #-clisp 'type #+clisp 'clos::$type) + (defun describe-db-layout (class) (flet ((not-db-col (col) (not (member (nth 2 col) '(nil :base :key)))) (frob-slot (slot) - (let ((type (slot-value slot 'type))) + (let ((type (slot-value slot *impl-type-attrib-name*))) (if (eq type t) (setq type nil)) (list (slot-value slot 'name) @@ -423,7 +425,7 @@ which does type checking before storing a value in a slot." (car list) list)) -(declaim (inline delistify)) +(declaim (inline delistify-dsd)) (defun delistify-dsd (list) "Some MOPs, like openmcl 0.14.2, cons attribute values in a list." (if (and (listp list) (null (cdr list))) @@ -442,7 +444,7 @@ which does type checking before storing a value in a slot." (null (specified-type dsd))) (setf (specified-type dsd) (slot-definition-type dsd)) - (setf (slot-value dsd 'type) + (setf (slot-value dsd *impl-type-attrib-name*) (compute-lisp-type-from-slot-specification dsd (slot-definition-type dsd))))