From b956c76026d39e3aaa065e64a100e3ad16d03cd5 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 28 Sep 2004 11:16:28 +0000 Subject: [PATCH] r10048: support clisp's attribute name for the type field in class direct slots --- ChangeLog | 4 ++++ sql/metaclasses.lisp | 6 ++++-- 2 files changed, 8 insertions(+), 2 deletions(-) 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)))) -- 2.34.1