Work in progress, recovered from old crybaby.

[sod] / src / impl-c-types.lisp

diff --git a/src/impl-c-types.lisp b/src/impl-c-types.lisp
index 7892565ee404df2bdb81665f0861a4a7bf092ae8..b37833a06385fa82cbaee9b638306d4b208da5f7 100644 (file)
--- a/src/impl-c-types.lisp
+++ b/src/impl-c-types.lisp
@@ -66,6 +66,16 @@ (defun check-type-intern-map ()
                 (assert (gethash k map))))
             *c-type-intern-map*)))
 
+(defmethod qualify-c-type ((type qualifiable-c-type) qualifiers)
+  (let ((initargs (instance-initargs type)))
+    (remf initargs :qualifiers)
+    (apply (if (gethash type *c-type-intern-map*)
+              #'intern-c-type #'make-instance)
+          (class-of type)
+          :qualifiers (canonify-qualifiers
+                       (append qualifiers (c-type-qualifiers type)))
+          initargs)))
+
 ;;;--------------------------------------------------------------------------
 ;;; Simple C types.
 
@@ -209,7 +219,7 @@ (macrolet ((define-tagged-type (kind what)
                    (keyword (intern (symbol-name kind) :keyword))
                    (constructor (symbolicate 'make- kind '-type)))
               `(progn
-                 (export '(,type ,constructor))
+                 (export '(,type ,kind ,constructor))
                  (defclass ,type (tagged-c-type) ()
                    (:documentation ,(format nil "C ~a types." what)))
                  (defmethod c-tagged-type-kind ((type ,type))