From: Kevin M. Rosenberg Date: Tue, 28 Sep 2004 11:16:28 +0000 (+0000) Subject: r10048: support clisp's attribute name for the type field in class direct slots X-Git-Tag: v3.8.6~228 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=b956c76026d39e3aaa065e64a100e3ad16d03cd5 r10048: support clisp's attribute name for the type field in class direct slots --- diff --git a/ChangeLog b/ChangeLog index 69cf44d..3991ab8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +28 Sep 2004 Kevin Rosenberg + * sql/metaclass.lisp: Support CLISP's attribute name + for the type field in direct class slots + 27 Sep 2004 Kevin Rosenberg * Version 3.0.6 released * BUGS: New file. Document suspected SIGPIPE diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp index bb02da3..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) @@ -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))))