chiark - git - mdw - sod/blob - src/c-types-impl.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; C type representation implementation
   4 ;;;
   5 ;;; (c) 2009 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of the Sensible Object Design, an object system for C.
  11 ;;;
  12 ;;; SOD is free software; you can redistribute it and/or modify
  13 ;;; it under the terms of the GNU General Public License as published by
  14 ;;; the Free Software Foundation; either version 2 of the License, or
  15 ;;; (at your option) any later version.
  16 ;;;
  17 ;;; SOD is distributed in the hope that it will be useful,
  18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;;; GNU General Public License for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with SOD; if not, write to the Free Software Foundation,
  24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 (cl:in-package #:sod)
  27
  28 ;;;--------------------------------------------------------------------------
  29 ;;; Interning types.
  30
  31 (defparameter *c-type-intern-map* (make-hash-table :test #'equal)
  32   "Hash table mapping lists describing types to their distinguished
  33    representations.")
  34
  35 (defun intern-c-type (class &rest initargs)
  36   "If the CLASS and INITARGS have already been interned, then return the
  37    existing object; otherwise make a new one."
  38   (let ((list (cons class initargs)))
  39     (or (gethash list *c-type-intern-map*)
  40         (let ((new (apply #'make-instance class initargs)))
  41           (setf (gethash new *c-type-intern-map*) t
  42                 (gethash list *c-type-intern-map*) new)))))
  43
  44 #+test
  45 (defun check-type-intern-map ()
  46   "Sanity check for the type-intern map."
  47   (let ((map (make-hash-table)))
  48
  49     ;; Pass 1: check that interned types are consistent with their keys.
  50     ;; Remember interned types.
  51     (maphash (lambda (k v)
  52                (when (listp k)
  53                  (let ((ty (apply #'make-instance k)))
  54                    (assert (c-type-equal-p ty v)))
  55                  (setf (gethash v map) t)))
  56              *c-type-intern-map*)
  57
  58     ;; Pass 2: check that the interned type indicators are correct.
  59     (maphash (lambda (k v)
  60                (declare (ignore v))
  61                (assert (gethash k *c-type-intern-map*)))
  62              map)
  63     (maphash (lambda (k v)
  64                (declare (ignore v))
  65                (when (typep k 'c-type)
  66                  (assert (gethash k map))))
  67              *c-type-intern-map*)))
  68
  69 (defmethod qualify-c-type ((type qualifiable-c-type) qualifiers)
  70   (let ((initargs (instance-initargs type)))
  71     (remf initargs :qualifiers)
  72     (apply (if (gethash type *c-type-intern-map*)
  73                #'intern-c-type #'make-instance)
  74            (class-of type)
  75            :qualifiers (canonify-qualifiers
  76                         (append qualifiers (c-type-qualifiers type)))
  77            initargs)))
  78
  79 ;;;--------------------------------------------------------------------------
  80 ;;; Simple C types.
  81
  82 ;; Class definition.
  83
  84 (export '(simple-c-type c-type-name))
  85 (defclass simple-c-type (qualifiable-c-type)
  86   ((name :initarg :name :type string :reader c-type-name))
  87   (:documentation
  88    "C types with simple forms."))
  89
  90 ;; Constructor function and interning.
  91
  92 (export 'make-simple-type)
  93 (defun make-simple-type (name &optional qualifiers)
  94   "Make a distinguished object for the simple type called NAME."
  95   (intern-c-type 'simple-c-type
  96                  :name name
  97                  :qualifiers (canonify-qualifiers qualifiers)))
  98
  99 ;; Comparison protocol.
 100
 101 (defmethod c-type-equal-p and
 102     ((type-a simple-c-type) (type-b simple-c-type))
 103   (string= (c-type-name type-a) (c-type-name type-b)))
 104
 105 ;; C syntax output protocol.
 106
 107 (defmethod pprint-c-type ((type simple-c-type) stream kernel)
 108   (pprint-logical-block (stream nil)
 109     (format stream "~{~(~A~) ~@_~}~A"
 110             (c-type-qualifiers type)
 111             (c-type-name type))
 112     (funcall kernel stream 0 t)))
 113
 114 ;; S-expression notation protocol.
 115
 116 (defparameter *simple-type-map* (make-hash-table)
 117   "Hash table mapping strings of C syntax to symbolic names.")
 118
 119 (defmethod print-c-type (stream (type simple-c-type) &optional colon atsign)
 120   (declare (ignore colon atsign))
 121   (let* ((name (c-type-name type))
 122          (symbol (gethash name *simple-type-map*)))
 123     (format stream "~:[~S~;~:@<~S~0@*~{ ~_~S~}~:>~]"
 124             (c-type-qualifiers type) (or symbol name))))
 125
 126 (eval-when (:compile-toplevel :load-toplevel :execute)
 127   (defmethod expand-c-type-spec ((spec string))
 128     `(make-simple-type ,spec))
 129   (defmethod expand-c-type-form ((head string) tail)
 130     `(make-simple-type ,head (list ,@tail))))
 131
 132 (export 'define-simple-c-type)
 133 (defmacro define-simple-c-type (names type &key export)
 134   "Define each of NAMES to be a simple type called TYPE."
 135   (let ((names (if (listp names) names (list names))))
 136     `(progn
 137        (setf (gethash ,type *simple-type-map*) ',(car names))
 138        (defctype ,names ,type :export ,export)
 139        (define-c-type-syntax ,(car names) (&rest quals)
 140          `(make-simple-type ,',type (list ,@quals))))))
 141
 142 ;; Built-in C types.
 143
 144 (define-simple-c-type void "void" :export t)
 145
 146 (define-simple-c-type char "char" :export t)
 147 (define-simple-c-type (unsigned-char uchar) "unsigned char" :export t)
 148 (define-simple-c-type (signed-char schar) "signed char" :export t)
 149 (define-simple-c-type wchar-t "wchar-t" :export t)
 150
 151 (define-simple-c-type (int signed signed-int sint) "int" :export t)
 152 (define-simple-c-type (unsigned unsigned-int uint) "unsigned" :export t)
 153
 154 (define-simple-c-type (short signed-short short-int signed-short-int sshort)
 155   "short" :export t)
 156 (define-simple-c-type (unsigned-short unsigned-short-int ushort)
 157   "unsigned short" :export t)
 158
 159 (define-simple-c-type (long signed-long long-int signed-long-int slong)
 160   "long" :export t)
 161 (define-simple-c-type (unsigned-long unsigned-long-int ulong)
 162   "unsigned long" :export t)
 163
 164 (define-simple-c-type (long-long signed-long-long long-long-int
 165                        signed-long-long-int llong sllong)
 166   "long long" :export t)
 167 (define-simple-c-type (unsigned-long-long unsigned-long-long-int ullong)
 168   "unsigned long long" :export t)
 169
 170 (define-simple-c-type float "float" :export t)
 171 (define-simple-c-type double "double" :export t)
 172 (define-simple-c-type long-double "long double" :export t)
 173
 174 (define-simple-c-type bool "_Bool" :export t)
 175
 176 (define-simple-c-type float-complex "float _Complex" :export t)
 177 (define-simple-c-type double-complex "double _Complex" :export t)
 178 (define-simple-c-type long-double-complex "long double _Complex" :export t)
 179
 180 (define-simple-c-type float-imaginary "float _Imaginary" :export t)
 181 (define-simple-c-type double-imaginary "double _Imaginary" :export t)
 182 (define-simple-c-type long-double-imaginary
 183     "long double _Imaginary" :export t)
 184
 185 (define-simple-c-type va-list "va_list" :export t)
 186 (define-simple-c-type size-t "size_t" :export t)
 187 (define-simple-c-type ptrdiff-t "ptrdiff_t" :export t)
 188
 189 ;;;--------------------------------------------------------------------------
 190 ;;; Tagged types (enums, structs and unions).
 191
 192 ;; Class definition.
 193
 194 (export '(tagged-c-type c-type-tag))
 195 (defclass tagged-c-type (qualifiable-c-type)
 196   ((tag :initarg :tag :type string :reader c-type-tag))
 197   (:documentation
 198    "C types with tags."))
 199
 200 ;; Subclass definitions.
 201
 202 (export 'c-tagged-type-kind)
 203 (defgeneric c-tagged-type-kind (type)
 204   (:documentation
 205    "Return the kind of tagged type that TYPE is, as a keyword."))
 206
 207 (export 'kind-c-tagged-type)
 208 (defgeneric kind-c-tagged-type (kind)
 209   (:documentation
 210    "Given a keyword KIND, return the appropriate class name."))
 211
 212 (export 'make-c-tagged-type)
 213 (defun make-c-tagged-type (kind tag &optional qualifiers)
 214   "Return a tagged type with the given KIND (keyword) and TAG (string)."
 215   (intern-c-type (kind-c-tagged-type kind)
 216                  :tag tag
 217                  :qualifiers (canonify-qualifiers qualifiers)))
 218
 219 (macrolet ((define-tagged-type (kind what)
 220              (let* ((type (symbolicate 'c- kind '-type))
 221                     (keyword (intern (symbol-name kind) :keyword))
 222                     (constructor (symbolicate 'make- kind '-type)))
 223                `(progn
 224                   (export '(,type ,kind ,constructor))
 225                   (defclass ,type (tagged-c-type) ()
 226                     (:documentation ,(format nil "C ~a types." what)))
 227                   (defmethod c-tagged-type-kind ((type ,type))
 228                     ',keyword)
 229                   (defmethod kind-c-tagged-type ((kind (eql ',keyword)))
 230                     ',type)
 231                   (defun ,constructor (tag &optional qualifiers)
 232                     (intern-c-type ',type :tag tag
 233                                    :qualifiers (canonify-qualifiers
 234                                                 qualifiers)))
 235                   (define-c-type-syntax ,kind (tag &rest quals)
 236                     ,(format nil "Construct ~A type named TAG" what)
 237                     `(,',constructor ,tag (list ,@quals)))))))
 238   (define-tagged-type enum "enumerated")
 239   (define-tagged-type struct "structure")
 240   (define-tagged-type union "union"))
 241
 242 ;; Comparison protocol.
 243
 244 (defmethod c-type-equal-p and ((type-a tagged-c-type) (type-b tagged-c-type))
 245   (string= (c-type-tag type-a) (c-type-tag type-b)))
 246
 247 ;; C syntax output protocol.
 248
 249 (defmethod pprint-c-type ((type tagged-c-type) stream kernel)
 250   (pprint-logical-block (stream nil)
 251     (format stream "~{~(~A~) ~@_~}~(~A~) ~A"
 252             (c-type-qualifiers type)
 253             (c-tagged-type-kind type)
 254             (c-type-tag type))
 255     (funcall kernel stream 0 t)))
 256
 257 ;; S-expression notation protocol.
 258
 259 (defmethod print-c-type (stream (type tagged-c-type) &optional colon atsign)
 260   (declare (ignore colon atsign))
 261   (format stream "~:@<~S ~@_~S~{ ~_~S~}~:>"
 262           (c-tagged-type-kind type)
 263           (c-type-tag type)
 264           (c-type-qualifiers type)))
 265
 266 ;;;--------------------------------------------------------------------------
 267 ;;; Pointer types.
 268
 269 ;; Class definition.
 270
 271 (export 'c-pointer-type)
 272 (defclass c-pointer-type (qualifiable-c-type)
 273   ((subtype :initarg :subtype :type c-type :reader c-type-subtype))
 274   (:documentation "C pointer types."))
 275
 276 ;; Constructor function.
 277
 278 (export 'make-pointer-type)
 279 (defun make-pointer-type (subtype &optional qualifiers)
 280   "Return a (maybe distinguished) pointer type."
 281   (let ((canonical (canonify-qualifiers qualifiers)))
 282     (funcall (if (gethash subtype *c-type-intern-map*)
 283                  #'intern-c-type #'make-instance)
 284              'c-pointer-type
 285              :subtype subtype
 286              :qualifiers canonical)))
 287
 288 ;; Comparison protocol.
 289
 290 (defmethod c-type-equal-p and ((type-a c-pointer-type)
 291                                (type-b c-pointer-type))
 292   (c-type-equal-p (c-type-subtype type-a) (c-type-subtype type-b)))
 293
 294 ;; C syntax output protocol.
 295
 296 (defmethod pprint-c-type ((type c-pointer-type) stream kernel)
 297   (pprint-c-type (c-type-subtype type) stream
 298                  (lambda (stream prio spacep)
 299                    (when spacep (c-type-space stream))
 300                    (maybe-in-parens (stream (> prio 1))
 301                      (format stream "*~{~(~A~)~^ ~@_~}"
 302                              (c-type-qualifiers type))
 303                      (funcall kernel stream 1 (c-type-qualifiers type))))))
 304
 305 ;; S-expression notation protocol.
 306
 307 (defmethod print-c-type (stream (type c-pointer-type) &optional colon atsign)
 308   (declare (ignore colon atsign))
 309   (format stream "~:@<* ~@_~/sod:print-c-type/~{ ~_~S~}~:>"
 310           (c-type-subtype type)
 311           (c-type-qualifiers type)))
 312
 313 (export '(* pointer ptr))
 314 (define-c-type-syntax * (sub &rest quals)
 315   "Return the type of pointer-to-SUB."
 316   `(make-pointer-type ,(expand-c-type-spec sub) (list ,@quals)))
 317 (c-type-alias * pointer ptr)
 318
 319 ;; Built-in C types.
 320
 321 (export '(string const-string))
 322 (defctype string (* char))
 323 (defctype const-string (* (char :const)))
 324
 325 ;;;--------------------------------------------------------------------------
 326 ;;; Array types.
 327
 328 ;; Class definition.
 329
 330 (export '(c-array-type c-array-dimensions))
 331 (defclass c-array-type (c-type)
 332   ((subtype :initarg :subtype :type c-type :reader c-type-subtype)
 333    (dimensions :initarg :dimensions :type list :reader c-array-dimensions))
 334   (:documentation
 335    "C array types."))
 336
 337 ;; Constructor function.
 338
 339 (export 'make-array-type)
 340 (defun make-array-type (subtype dimensions)
 341   "Return a new array of SUBTYPE with given DIMENSIONS."
 342   (make-instance 'c-array-type :subtype subtype
 343                  :dimensions (or dimensions '(nil))))
 344
 345 ;; Comparison protocol.
 346
 347 (defmethod c-type-equal-p and ((type-a c-array-type) (type-b c-array-type))
 348
 349   ;; Messy.  C doesn't have multidimensional arrays, but we fake them for
 350   ;; convenience's sake.  But it means that we have to arrange for
 351   ;; multidimensional arrays to equal vectors of vectors -- and in general
 352   ;; for multidimensional arrays of multidimensional arrays to match each
 353   ;; other properly, even when their dimensions don't align precisely.
 354   (labels ((check (sub-a dim-a sub-b dim-b)
 355              (cond ((endp dim-a)
 356                     (cond ((endp dim-b)
 357                            (c-type-equal-p sub-a sub-b))
 358                           ((typep sub-a 'c-array-type)
 359                            (check (c-type-subtype sub-a)
 360                                   (c-array-dimensions sub-a)
 361                                   sub-b dim-b))
 362                           (t
 363                            nil)))
 364                    ((endp dim-b)
 365                     (check sub-b dim-b sub-a dim-a))
 366                    ((equal (car dim-a) (car dim-b))
 367                     (check sub-a (cdr dim-a) sub-b (cdr dim-b)))
 368                    (t
 369                     nil))))
 370     (check (c-type-subtype type-a) (c-array-dimensions type-a)
 371            (c-type-subtype type-b) (c-array-dimensions type-b))))
 372
 373 ;; C syntax output protocol.
 374
 375 (defmethod pprint-c-type ((type c-array-type) stream kernel)
 376   (pprint-c-type (c-type-subtype type) stream
 377                  (lambda (stream prio spacep)
 378                    (maybe-in-parens (stream (> prio 2))
 379                      (funcall kernel stream 2 spacep)
 380                      (format stream "~@<~{[~@[~A~]]~^~_~}~:>"
 381                              (c-array-dimensions type))))))
 382
 383 ;; S-expression notation protocol.
 384
 385 (defmethod print-c-type (stream (type c-array-type) &optional colon atsign)
 386   (declare (ignore colon atsign))
 387   (format stream "~:@<[] ~@_~:I~/sod:print-c-type/~{ ~_~S~}~:>"
 388           (c-type-subtype type)
 389           (c-array-dimensions type)))
 390
 391 (export '([] array vec))
 392 (define-c-type-syntax [] (sub &rest dims)
 393   "Return the type of arrays of SUB with the dimensions DIMS.
 394
 395    If the DIMS are omitted, a single unknown-length dimension is added."
 396   `(make-array-type ,(expand-c-type-spec sub)
 397                     (list ,@(or dims '(nil)))))
 398 (c-type-alias [] array vec)
 399
 400 ;;;--------------------------------------------------------------------------
 401 ;;; Function types.
 402
 403 ;; Function arguments.
 404
 405 (defun argument-lists-equal-p (list-a list-b)
 406   "Return whether LIST-A and LIST-B match.
 407
 408    They must have the same number of arguments, and each argument must have
 409    the same type, or be `:ellipsis'.  The argument names are not inspected."
 410   (and (= (length list-a) (length list-b))
 411        (every (lambda (arg-a arg-b)
 412                 (if (eq arg-a :ellipsis)
 413                     (eq arg-b :ellipsis)
 414                     (and (argumentp arg-a) (argumentp arg-b)
 415                          (c-type-equal-p (argument-type arg-a)
 416                                          (argument-type arg-b)))))
 417               list-a list-b)))
 418
 419 ;; Class definition.
 420
 421 (export '(c-function-type c-function-arguments))
 422 (defclass c-function-type (c-type)
 423   ((subtype :initarg :subtype :type c-type :reader c-type-subtype)
 424    (arguments :type list :reader c-function-arguments))
 425   (:documentation
 426    "C function types.  The subtype is the return type, as implied by the C
 427     syntax for function declarations."))
 428
 429 (defmethod shared-initialize :after
 430     ((type c-function-type) slot-names &key (arguments nil argsp))
 431   (declare (ignore slot-names))
 432   (when argsp
 433     (setf (slot-value type 'arguments)
 434           (if (and arguments
 435                    (null (cdr arguments))
 436                    (not (eq (car arguments) :ellipsis))
 437                    (eq (argument-type (car arguments)) c-type-void))
 438               nil
 439               arguments))))
 440
 441 ;; Constructor function.
 442
 443 (export 'make-function-type)
 444 (defun make-function-type (subtype arguments)
 445   "Return a new function type, returning SUBTYPE and accepting ARGUMENTS."
 446   (make-instance 'c-function-type :subtype subtype
 447                  :arguments arguments))
 448
 449 ;; Comparison protocol.
 450
 451 (defmethod c-type-equal-p and
 452     ((type-a c-function-type) (type-b c-function-type))
 453   (and (c-type-equal-p (c-type-subtype type-a) (c-type-subtype type-b))
 454        (argument-lists-equal-p (c-function-arguments type-a)
 455                                (c-function-arguments type-b))))
 456
 457 ;; C syntax output protocol.
 458
 459 (export 'pprint-c-function-type)
 460 (defun pprint-c-function-type (return-type stream print-args print-kernel)
 461   "Common top-level printing for function types.
 462
 463    Prints RETURN-TYPE (KERNEL(ARGS)), where RETURN-TYPE is the actual return
 464    type, and ARGS and KERNEL are whatever is printed by the PRINT-ARGS and
 465    PRINT-KERNEL functions.
 466
 467    The PRINT-KERNEL function is the standard such thing for the
 468    `pprint-c-type' protocol; PRINT-ARGS accepts just an output stream."
 469   (pprint-c-type return-type stream
 470                  (lambda (stream prio spacep)
 471                    (maybe-in-parens (stream (> prio 2))
 472                      (when spacep (c-type-space stream))
 473                      (funcall print-kernel stream 2 nil)
 474                      (pprint-indent :block 4 stream)
 475                      (pprint-newline :linear stream)
 476                      (pprint-logical-block
 477                          (stream nil :prefix "(" :suffix ")")
 478                        (funcall print-args stream))))))
 479
 480 (export 'pprint-argument-list)
 481 (defun pprint-argument-list (args stream)
 482   "Print an argument list.
 483
 484    The ARGS is a list of `argument' objects, optionally containing an
 485    `:ellipsis' marker.  The output is written to STREAM.
 486
 487    Returns non-nil if any arguments were actually printed."
 488   (let ((anyp nil))
 489     (pprint-logical-block (stream nil)
 490       (dolist (arg args)
 491         (if anyp
 492             (format stream ", ~_")
 493             (setf anyp t))
 494         (etypecase arg
 495           ((member :ellipsis)
 496            (write-string "..." stream))
 497           (argument
 498            (pprint-logical-block (stream nil)
 499              (pprint-c-type (argument-type arg) stream
 500                             (argument-name arg)))))))
 501     anyp))
 502
 503 (let ((void-arglist (list (make-argument nil c-type-void))))
 504   (defmethod pprint-c-type ((type c-function-type) stream kernel)
 505     (let ((args (or (c-function-arguments type) void-arglist)))
 506       (pprint-c-function-type (c-type-subtype type) stream
 507                               (lambda (stream)
 508                                 (pprint-argument-list args stream))
 509                               kernel))))
 510
 511 ;; S-expression notation protocol.
 512
 513 (defmethod print-c-type
 514     (stream (type c-function-type) &optional colon atsign)
 515   (declare (ignore colon atsign))
 516   (format stream "~:@<~
 517                   FUN ~@_~:I~
 518                   ~/sod:print-c-type/~:[~; ~]~:*~_~
 519                   ~<~@{~:<~S ~@_~/sod:print-c-type/~:>~^ ~_~}~:>~
 520                   ~:>"
 521           (c-type-subtype type)
 522           (mapcar (lambda (arg)
 523                     (if (eq arg :ellipsis) arg
 524                         (list (argument-name arg) (argument-type arg))))
 525                   (c-function-arguments type))))
 526
 527 (export '(fun function () func fn))
 528 (define-c-type-syntax fun (ret &rest args)
 529   "Return the type of functions which returns RET and has arguments ARGS.
 530
 531    The ARGS are a list of arguments of the form (NAME TYPE).  The NAME can be
 532    NIL to indicate that no name was given.
 533
 534    If an entry isn't a list, it's assumed to be the start of a Lisp
 535    expression to compute the tail of the list; similarly, if the list is
 536    improper, then it's considered to be a complete expression.  The upshot of
 537    this apparently bizarre rule is that you can say
 538
 539      (c-type (fun int (\"foo\" int) . arg-tail))
 540
 541    where ARG-TAIL is (almost) any old Lisp expression and have it tack the
 542    arguments onto the end.  Of course, there don't have to be any explicit
 543    arguments at all.  The only restriction is that the head of the Lisp form
 544    can't be a list -- so ((lambda (...) ...) ...) is out, but you probably
 545    wouldn't type that anyway."
 546
 547   `(make-function-type ,(expand-c-type-spec ret)
 548                        ,(do ((args args (cdr args))
 549                              (list nil
 550                                    (cons `(make-argument ,(caar args)
 551                                                          ,(expand-c-type-spec
 552                                                            (cadar args)))
 553                                          list)))
 554                             ((or (atom args) (atom (car args)))
 555                              (cond ((and (null args) (null list)) `nil)
 556                                    ((null args) `(list ,@(nreverse list)))
 557                                    ((and (consp args)
 558                                          (eq (car args) :ellipsis))
 559                                     `(list ,@(nreverse list) :ellipsis))
 560                                    ((null list) `,args)
 561                                    (t `(list* ,@(nreverse list) ,args)))))))
 562 (c-type-alias fun function () func fn)
 563
 564 ;; Additional utilities for dealing with functions.
 565
 566 (export 'commentify-argument-names)
 567 (defun commentify-argument-names (arguments)
 568   "Return an argument list with the arguments commentified.
 569
 570    That is, with each argument name passed through
 571    `commentify-argument-name'."
 572   (mapcar (lambda (arg)
 573             (if (eq arg :ellipsis) arg
 574                 (make-argument (commentify-argument-name (argument-name arg))
 575                                (argument-type arg))))
 576           arguments))
 577
 578 (export 'commentify-function-type)
 579 (defun commentify-function-type (type)
 580   "Return a type like TYPE, but with arguments commentified.
 581
 582    This doesn't recurse into the return type or argument types."
 583   (make-function-type (c-type-subtype type)
 584                       (commentify-argument-names
 585                        (c-function-arguments type))))
 586
 587 (export 'reify-variable-argument-tail)
 588 (defun reify-variable-argument-tail (arguments)
 589   "Replace any `:ellipsis' item in ARGUMENTS with a `va_list' argument.
 590
 591    The argument's name is taken from the variable `*sod-ap*'."
 592   (substitute (make-argument *sod-ap* c-type-va-list) :ellipsis arguments))
 593
 594 ;;;----- That's all, folks --------------------------------------------------