(assert (gethash k map))))
*c-type-intern-map*)))
+(defun make-or-intern-c-type (new-type-class base-types &rest initargs)
+ "Return a possibly-new instance of NEW-TYPE-CLASS with the given INITARGS.
+
+ If all of the BASE-TYPES are interned, then use `intern-c-type' to
+ construct the new type; otherwise just make a new one with
+ `make-instance'. BASE-TYPES may be a singleton type, or a sequence of
+ types."
+ (apply (if (if (typep base-types 'sequence)
+ (every (lambda (type)
+ (gethash type *c-type-intern-map*))
+ base-types)
+ (gethash base-types *c-type-intern-map*))
+ #'intern-c-type #'make-instance)
+ new-type-class
+ initargs))
+
(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)
+ (apply #'make-or-intern-c-type (class-of type) type
:qualifiers (canonify-qualifiers
(append qualifiers (c-type-qualifiers type)))
initargs)))
`(make-simple-type ,head (list ,@tail))))
(export 'define-simple-c-type)
-(defmacro define-simple-c-type (names type)
+(defmacro define-simple-c-type (names type &key export)
"Define each of NAMES to be a simple type called TYPE."
(let ((names (if (listp names) names (list names))))
`(progn
(setf (gethash ,type *simple-type-map*) ',(car names))
- (defctype ,names ,type)
+ (defctype ,names ,type :export ,export)
(define-c-type-syntax ,(car names) (&rest quals)
`(make-simple-type ,',type (list ,@quals))))))
;; Built-in C types.
-(export '(void
- float double long-double
- float-complex double-complex long-double-complex
- float-imaginary double-imaginary long-double-imaginary
- va-list size-t ptrdiff-t wchar-t
- char unsigned-char uchar signed-char schar
- int signed signed-int sint unsigned unsigned-int uint
- short signed-short short-int signed-short-int sshort
- unsigned-short unsigned-short-int ushort
- long signed-long long-int signed-long-int slong
- unsigned-long unsigned-long-int ulong
- long-long signed-long-long long-long-int signed-long-long-int
- unsigned-long-long unsigned-long-long-int llong sllong ullong))
-
-(define-simple-c-type void "void")
-
-(define-simple-c-type char "char")
-(define-simple-c-type (unsigned-char uchar) "unsigned char")
-(define-simple-c-type (signed-char schar) "signed char")
-(define-simple-c-type wchar-t "wchar-t")
-
-(define-simple-c-type (int signed signed-int sint) "int")
-(define-simple-c-type (unsigned unsigned-int uint) "unsigned")
+(define-simple-c-type void "void" :export t)
+
+(define-simple-c-type char "char" :export t)
+(define-simple-c-type (unsigned-char uchar) "unsigned char" :export t)
+(define-simple-c-type (signed-char schar) "signed char" :export t)
+(define-simple-c-type wchar-t "wchar-t" :export t)
+
+(define-simple-c-type (int signed signed-int sint) "int" :export t)
+(define-simple-c-type (unsigned unsigned-int uint) "unsigned" :export t)
(define-simple-c-type (short signed-short short-int signed-short-int sshort)
- "short")
+ "short" :export t)
(define-simple-c-type (unsigned-short unsigned-short-int ushort)
- "unsigned short")
+ "unsigned short" :export t)
(define-simple-c-type (long signed-long long-int signed-long-int slong)
- "long")
+ "long" :export t)
(define-simple-c-type (unsigned-long unsigned-long-int ulong)
- "unsigned long")
+ "unsigned long" :export t)
(define-simple-c-type (long-long signed-long-long long-long-int
signed-long-long-int llong sllong)
- "long long")
+ "long long" :export t)
(define-simple-c-type (unsigned-long-long unsigned-long-long-int ullong)
- "unsigned long long")
+ "unsigned long long" :export t)
-(define-simple-c-type float "float")
-(define-simple-c-type double "double")
-(define-simple-c-type long-double "long double")
+(define-simple-c-type float "float" :export t)
+(define-simple-c-type double "double" :export t)
+(define-simple-c-type long-double "long double" :export t)
-(define-simple-c-type bool "_Bool")
+(define-simple-c-type bool "_Bool" :export t)
-(define-simple-c-type float-complex "float _Complex")
-(define-simple-c-type double-complex "double _Complex")
-(define-simple-c-type long-double-complex "long double _Complex")
+(define-simple-c-type float-complex "float _Complex" :export t)
+(define-simple-c-type double-complex "double _Complex" :export t)
+(define-simple-c-type long-double-complex "long double _Complex" :export t)
-(define-simple-c-type float-imaginary "float _Imaginary")
-(define-simple-c-type double-imaginary "double _Imaginary")
-(define-simple-c-type long-double-imaginary "long double _Imaginary")
+(define-simple-c-type float-imaginary "float _Imaginary" :export t)
+(define-simple-c-type double-imaginary "double _Imaginary" :export t)
+(define-simple-c-type long-double-imaginary
+ "long double _Imaginary" :export t)
-(define-simple-c-type va-list "va_list")
-(define-simple-c-type size-t "size_t")
-(define-simple-c-type ptrdiff-t "ptrdiff_t")
+(define-simple-c-type va-list "va_list" :export t)
+(define-simple-c-type size-t "size_t" :export t)
+(define-simple-c-type ptrdiff-t "ptrdiff_t" :export t)
;;;--------------------------------------------------------------------------
;;; Tagged types (enums, structs and unions).
(export 'make-pointer-type)
(defun make-pointer-type (subtype &optional qualifiers)
"Return a (maybe distinguished) pointer type."
- (let ((canonical (canonify-qualifiers qualifiers)))
- (funcall (if (gethash subtype *c-type-intern-map*)
- #'intern-c-type #'make-instance)
- 'c-pointer-type
- :subtype subtype
- :qualifiers canonical)))
+ (make-or-intern-c-type 'c-pointer-type subtype
+ :subtype subtype
+ :qualifiers (canonify-qualifiers qualifiers)))
;; Comparison protocol.