src/classes.lisp: Fix `print-object' on `sod-initializer'.

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

diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp
index 56eee890a0b64262957906a792690a0b8a3ee7ad..9257bf232c8de6da37a6cb4968f3c24e155dd767 100644 (file)
--- a/src/c-types-impl.lisp
+++ b/src/c-types-impl.lisp
@@ -130,74 +130,61 @@   (defmethod expand-c-type-form ((head string) tail)
     `(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).
@@ -415,7 +402,7 @@ (c-type-alias [] array vec)
 
 ;; Function arguments.
 
-(defun arguments-lists-equal-p (list-a list-b)
+(defun argument-lists-equal-p (list-a list-b)
   "Return whether LIST-A and LIST-B match.
 
    They must have the same number of arguments, and each argument must have
@@ -424,8 +411,9 @@ (defun arguments-lists-equal-p (list-a list-b)
        (every (lambda (arg-a arg-b)
                (if (eq arg-a :ellipsis)
                    (eq arg-b :ellipsis)
-                   (c-type-equal-p (argument-type arg-a)
-                                   (argument-type arg-b))))
+                   (and (argumentp arg-a) (argumentp arg-b)
+                        (c-type-equal-p (argument-type arg-a)
+                                        (argument-type arg-b)))))
              list-a list-b)))
 
 ;; Class definition.
@@ -463,8 +451,8 @@ (defun make-function-type (subtype arguments)
 (defmethod c-type-equal-p and
     ((type-a c-function-type) (type-b c-function-type))
   (and (c-type-equal-p (c-type-subtype type-a) (c-type-subtype type-b))
-       (arguments-lists-equal-p (c-function-arguments type-a)
-                               (c-function-arguments type-b))))
+       (argument-lists-equal-p (c-function-arguments type-a)
+                              (c-function-arguments type-b))))
 
 ;; C syntax output protocol.
 
@@ -501,8 +489,7 @@ (defmethod print-c-type
                  ~:>"
          (c-type-subtype type)
          (mapcar (lambda (arg)
-                   (if (eq arg :ellipsis)
-                       arg
+                   (if (eq arg :ellipsis) arg
                        (list (argument-name arg) (argument-type arg))))
                  (c-function-arguments type))))
 
@@ -552,8 +539,7 @@ (defun commentify-argument-names (arguments)
    That is, with each argument name passed through
    `commentify-argument-name'."
   (mapcar (lambda (arg)
-           (if (eq arg :ellipsis)
-               arg
+           (if (eq arg :ellipsis) arg
                (make-argument (commentify-argument-name (argument-name arg))
                               (argument-type arg))))
          arguments))