src/c-types-impl.lisp: Fix arg list in `c-function-type' instance init.
authorMark Wooding <mdw@distorted.org.uk>
Sun, 30 Aug 2015 09:58:38 +0000 (10:58 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Sun, 20 Sep 2015 09:54:33 +0000 (10:54 +0100)
Previously, `make-function-type' was responsible for spotting `(void)'
argument lists and converting them into empty lists, so if you used
`make-instance' directly you could sneak an actual `(void)' argument
list int.  Now the instance initialization machinery for the
`c-function-type' class does this itself, so the gap is closed.

src/c-types-impl.lisp

index 4a0f6e2..ed65110 100644 (file)
 (export '(c-function-type c-function-arguments))
 (defclass c-function-type (c-type)
   ((subtype :initarg :subtype :type c-type :reader c-type-subtype)
-   (arguments :initarg :arguments :type list :reader c-function-arguments))
+   (arguments :type list :reader c-function-arguments))
   (:documentation
    "C function types.  The subtype is the return type, as implied by the C
     syntax for function declarations."))
 
+(defmethod shared-initialize :after
+    ((type c-function-type) slot-names &key (arguments nil argsp))
+  (declare (ignore slot-names))
+  (when argsp
+    (setf (slot-value type 'arguments)
+         (if (and arguments
+                  (null (cdr arguments))
+                  (not (eq (car arguments) :ellipsis))
+                  (eq (argument-type (car arguments)) c-type-void))
+             nil
+             arguments))))
+
 ;; Constructor function.
 
 (export 'make-function-type)
 (defun make-function-type (subtype arguments)
   "Return a new function type, returning SUBTYPE and accepting ARGUMENTS."
   (make-instance 'c-function-type :subtype subtype
-                :arguments (if (and arguments
-                                    (null (cdr arguments))
-                                    (not (eq (car arguments) :ellipsis))
-                                    (eq (argument-type (car arguments))
-                                        c-type-void))
-                               nil
-                               arguments)))
+                :arguments arguments))
 
 ;; Comparison protocol.