src/c-types-{impl,parse}.tex: Support `_Atomic' types.
[sod] / src / c-types-impl.lisp
CommitLineData
abdf50aa
MW
1;;; -*-lisp-*-
2;;;
dea4d055 3;;; C type representation implementation
abdf50aa 4;;;
dea4d055 5;;; (c) 2009 Straylight/Edgeware
abdf50aa
MW
6;;;
7
8;;;----- Licensing notice ---------------------------------------------------
9;;;
e0808c47 10;;; This file is part of the Sensible Object Design, an object system for C.
abdf50aa
MW
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;;;--------------------------------------------------------------------------
dea4d055
MW
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*)))
abdf50aa 68
2b2252cc
MW
69(defun make-or-intern-c-type (new-type-class base-types &rest initargs)
70 "Return a possibly-new instance of NEW-TYPE-CLASS with the given INITARGS.
71
72 If all of the BASE-TYPES are interned, then use `intern-c-type' to
73 construct the new type; otherwise just make a new one with
74 `make-instance'. BASE-TYPES may be a singleton type, or a sequence of
75 types."
76 (apply (if (if (typep base-types 'sequence)
77 (every (lambda (type)
78 (gethash type *c-type-intern-map*))
79 base-types)
80 (gethash base-types *c-type-intern-map*))
81 #'intern-c-type #'make-instance)
82 new-type-class
83 initargs))
84
b5c8ba34
MW
85;;;--------------------------------------------------------------------------
86;;; Qualifiers.
87
88(defmethod c-qualifier-keyword ((qualifier (eql :atomic))) "_Atomic")
89
bf090e02
MW
90(defmethod qualify-c-type ((type qualifiable-c-type) qualifiers)
91 (let ((initargs (instance-initargs type)))
92 (remf initargs :qualifiers)
2b2252cc 93 (apply #'make-or-intern-c-type (class-of type) type
bf090e02
MW
94 :qualifiers (canonify-qualifiers
95 (append qualifiers (c-type-qualifiers type)))
96 initargs)))
97
abdf50aa 98;;;--------------------------------------------------------------------------
dea4d055 99;;; Simple C types.
abdf50aa 100
dea4d055 101;; Class definition.
abdf50aa 102
dea4d055
MW
103(export '(simple-c-type c-type-name))
104(defclass simple-c-type (qualifiable-c-type)
105 ((name :initarg :name :type string :reader c-type-name))
abdf50aa 106 (:documentation
dea4d055 107 "C types with simple forms."))
abdf50aa 108
dea4d055 109;; Constructor function and interning.
abdf50aa 110
dea4d055
MW
111(export 'make-simple-type)
112(defun make-simple-type (name &optional qualifiers)
113 "Make a distinguished object for the simple type called NAME."
114 (intern-c-type 'simple-c-type
115 :name name
116 :qualifiers (canonify-qualifiers qualifiers)))
abdf50aa 117
dea4d055 118;; Comparison protocol.
abdf50aa 119
dea4d055
MW
120(defmethod c-type-equal-p and
121 ((type-a simple-c-type) (type-b simple-c-type))
122 (string= (c-type-name type-a) (c-type-name type-b)))
abdf50aa 123
dea4d055 124;; C syntax output protocol.
1f1d88f5
MW
125
126(defmethod pprint-c-type ((type simple-c-type) stream kernel)
127 (pprint-logical-block (stream nil)
ff4e398b
MW
128 (format stream "~{~A ~@_~}~A"
129 (c-type-qualifier-keywords type)
1f1d88f5
MW
130 (c-type-name type))
131 (funcall kernel stream 0 t)))
abdf50aa 132
dea4d055
MW
133;; S-expression notation protocol.
134
135(defparameter *simple-type-map* (make-hash-table)
136 "Hash table mapping strings of C syntax to symbolic names.")
abdf50aa
MW
137
138(defmethod print-c-type (stream (type simple-c-type) &optional colon atsign)
139 (declare (ignore colon atsign))
140 (let* ((name (c-type-name type))
141 (symbol (gethash name *simple-type-map*)))
1f1d88f5
MW
142 (format stream "~:[~S~;~:@<~S~0@*~{ ~_~S~}~:>~]"
143 (c-type-qualifiers type) (or symbol name))))
abdf50aa 144
1f1d88f5
MW
145(eval-when (:compile-toplevel :load-toplevel :execute)
146 (defmethod expand-c-type-spec ((spec string))
147 `(make-simple-type ,spec))
148 (defmethod expand-c-type-form ((head string) tail)
dea4d055 149 `(make-simple-type ,head (list ,@tail))))
abdf50aa 150
dea4d055 151(export 'define-simple-c-type)
e43d3532 152(defmacro define-simple-c-type (names type &key export)
abdf50aa 153 "Define each of NAMES to be a simple type called TYPE."
1f1d88f5
MW
154 (let ((names (if (listp names) names (list names))))
155 `(progn
156 (setf (gethash ,type *simple-type-map*) ',(car names))
e43d3532 157 (defctype ,names ,type :export ,export)
1f1d88f5
MW
158 (define-c-type-syntax ,(car names) (&rest quals)
159 `(make-simple-type ,',type (list ,@quals))))))
abdf50aa 160
dea4d055
MW
161;; Built-in C types.
162
e43d3532
MW
163(define-simple-c-type void "void" :export t)
164
165(define-simple-c-type char "char" :export t)
166(define-simple-c-type (unsigned-char uchar) "unsigned char" :export t)
167(define-simple-c-type (signed-char schar) "signed char" :export t)
168(define-simple-c-type wchar-t "wchar-t" :export t)
169
170(define-simple-c-type (int signed signed-int sint) "int" :export t)
171(define-simple-c-type (unsigned unsigned-int uint) "unsigned" :export t)
abdf50aa
MW
172
173(define-simple-c-type (short signed-short short-int signed-short-int sshort)
e43d3532 174 "short" :export t)
abdf50aa 175(define-simple-c-type (unsigned-short unsigned-short-int ushort)
e43d3532 176 "unsigned short" :export t)
abdf50aa
MW
177
178(define-simple-c-type (long signed-long long-int signed-long-int slong)
e43d3532 179 "long" :export t)
abdf50aa 180(define-simple-c-type (unsigned-long unsigned-long-int ulong)
e43d3532 181 "unsigned long" :export t)
abdf50aa
MW
182
183(define-simple-c-type (long-long signed-long-long long-long-int
184 signed-long-long-int llong sllong)
e43d3532 185 "long long" :export t)
abdf50aa 186(define-simple-c-type (unsigned-long-long unsigned-long-long-int ullong)
e43d3532 187 "unsigned long long" :export t)
abdf50aa 188
e43d3532
MW
189(define-simple-c-type float "float" :export t)
190(define-simple-c-type double "double" :export t)
191(define-simple-c-type long-double "long double" :export t)
abdf50aa 192
e43d3532 193(define-simple-c-type bool "_Bool" :export t)
0e7cdea0 194
e43d3532
MW
195(define-simple-c-type float-complex "float _Complex" :export t)
196(define-simple-c-type double-complex "double _Complex" :export t)
197(define-simple-c-type long-double-complex "long double _Complex" :export t)
0e7cdea0 198
e43d3532
MW
199(define-simple-c-type float-imaginary "float _Imaginary" :export t)
200(define-simple-c-type double-imaginary "double _Imaginary" :export t)
201(define-simple-c-type long-double-imaginary
202 "long double _Imaginary" :export t)
0e7cdea0 203
e43d3532
MW
204(define-simple-c-type va-list "va_list" :export t)
205(define-simple-c-type size-t "size_t" :export t)
206(define-simple-c-type ptrdiff-t "ptrdiff_t" :export t)
abdf50aa
MW
207
208;;;--------------------------------------------------------------------------
dea4d055 209;;; Tagged types (enums, structs and unions).
abdf50aa 210
dea4d055 211;; Class definition.
abdf50aa 212
dea4d055 213(export '(tagged-c-type c-type-tag))
abdf50aa 214(defclass tagged-c-type (qualifiable-c-type)
77027cca 215 ((tag :initarg :tag :type string :reader c-type-tag))
abdf50aa
MW
216 (:documentation
217 "C types with tags."))
218
dea4d055
MW
219;; Subclass definitions.
220
221(export 'c-tagged-type-kind)
abdf50aa
MW
222(defgeneric c-tagged-type-kind (type)
223 (:documentation
224 "Return the kind of tagged type that TYPE is, as a keyword."))
225
dea4d055
MW
226(export 'kind-c-tagged-type)
227(defgeneric kind-c-tagged-type (kind)
228 (:documentation
229 "Given a keyword KIND, return the appropriate class name."))
230
231(export 'make-c-tagged-type)
232(defun make-c-tagged-type (kind tag &optional qualifiers)
233 "Return a tagged type with the given KIND (keyword) and TAG (string)."
234 (intern-c-type (kind-c-tagged-type kind)
235 :tag tag
236 :qualifiers (canonify-qualifiers qualifiers)))
237
abdf50aa 238(macrolet ((define-tagged-type (kind what)
dea4d055
MW
239 (let* ((type (symbolicate 'c- kind '-type))
240 (keyword (intern (symbol-name kind) :keyword))
241 (constructor (symbolicate 'make- kind '-type)))
abdf50aa 242 `(progn
bf090e02 243 (export '(,type ,kind ,constructor))
abdf50aa
MW
244 (defclass ,type (tagged-c-type) ()
245 (:documentation ,(format nil "C ~a types." what)))
246 (defmethod c-tagged-type-kind ((type ,type))
dea4d055
MW
247 ',keyword)
248 (defmethod kind-c-tagged-type ((kind (eql ',keyword)))
249 ',type)
250 (defun ,constructor (tag &optional qualifiers)
251 (intern-c-type ',type :tag tag
252 :qualifiers (canonify-qualifiers
253 qualifiers)))
1f1d88f5
MW
254 (define-c-type-syntax ,kind (tag &rest quals)
255 ,(format nil "Construct ~A type named TAG" what)
256 `(,',constructor ,tag (list ,@quals)))))))
257 (define-tagged-type enum "enumerated")
258 (define-tagged-type struct "structure")
259 (define-tagged-type union "union"))
260
dea4d055
MW
261;; Comparison protocol.
262
263(defmethod c-type-equal-p and ((type-a tagged-c-type) (type-b tagged-c-type))
264 (string= (c-type-tag type-a) (c-type-tag type-b)))
265
266;; C syntax output protocol.
267
1f1d88f5
MW
268(defmethod pprint-c-type ((type tagged-c-type) stream kernel)
269 (pprint-logical-block (stream nil)
ff4e398b
MW
270 (format stream "~{~A ~@_~}~(~A~) ~A"
271 (c-type-qualifier-keywords type)
1f1d88f5
MW
272 (c-tagged-type-kind type)
273 (c-type-tag type))
274 (funcall kernel stream 0 t)))
abdf50aa 275
dea4d055 276;; S-expression notation protocol.
abdf50aa
MW
277
278(defmethod print-c-type (stream (type tagged-c-type) &optional colon atsign)
279 (declare (ignore colon atsign))
1f1d88f5 280 (format stream "~:@<~S ~@_~S~{ ~_~S~}~:>"
abdf50aa 281 (c-tagged-type-kind type)
1f1d88f5
MW
282 (c-type-tag type)
283 (c-type-qualifiers type)))
abdf50aa
MW
284
285;;;--------------------------------------------------------------------------
286;;; Pointer types.
287
dea4d055 288;; Class definition.
abdf50aa 289
dea4d055 290(export 'c-pointer-type)
abdf50aa 291(defclass c-pointer-type (qualifiable-c-type)
77027cca 292 ((subtype :initarg :subtype :type c-type :reader c-type-subtype))
dea4d055 293 (:documentation "C pointer types."))
abdf50aa 294
dea4d055
MW
295;; Constructor function.
296
297(export 'make-pointer-type)
298(defun make-pointer-type (subtype &optional qualifiers)
299 "Return a (maybe distinguished) pointer type."
2b2252cc
MW
300 (make-or-intern-c-type 'c-pointer-type subtype
301 :subtype subtype
302 :qualifiers (canonify-qualifiers qualifiers)))
dea4d055
MW
303
304;; Comparison protocol.
305
306(defmethod c-type-equal-p and ((type-a c-pointer-type)
307 (type-b c-pointer-type))
308 (c-type-equal-p (c-type-subtype type-a) (c-type-subtype type-b)))
309
310;; C syntax output protocol.
1f1d88f5
MW
311
312(defmethod pprint-c-type ((type c-pointer-type) stream kernel)
313 (pprint-c-type (c-type-subtype type) stream
314 (lambda (stream prio spacep)
315 (when spacep (c-type-space stream))
316 (maybe-in-parens (stream (> prio 1))
ff4e398b
MW
317 (format stream "*~{~A~^ ~@_~}"
318 (c-type-qualifier-keywords type))
1f1d88f5 319 (funcall kernel stream 1 (c-type-qualifiers type))))))
abdf50aa 320
dea4d055 321;; S-expression notation protocol.
abdf50aa
MW
322
323(defmethod print-c-type (stream (type c-pointer-type) &optional colon atsign)
324 (declare (ignore colon atsign))
dea4d055 325 (format stream "~:@<* ~@_~/sod:print-c-type/~{ ~_~S~}~:>"
1f1d88f5
MW
326 (c-type-subtype type)
327 (c-type-qualifiers type)))
abdf50aa 328
dea4d055 329(export '(* pointer ptr))
1f1d88f5 330(define-c-type-syntax * (sub &rest quals)
abdf50aa 331 "Return the type of pointer-to-SUB."
1f1d88f5
MW
332 `(make-pointer-type ,(expand-c-type-spec sub) (list ,@quals)))
333(c-type-alias * pointer ptr)
abdf50aa 334
dea4d055
MW
335;; Built-in C types.
336
337(export '(string const-string))
abdf50aa 338(defctype string (* char))
1f1d88f5 339(defctype const-string (* (char :const)))
abdf50aa
MW
340
341;;;--------------------------------------------------------------------------
342;;; Array types.
343
dea4d055 344;; Class definition.
abdf50aa 345
dea4d055 346(export '(c-array-type c-array-dimensions))
abdf50aa 347(defclass c-array-type (c-type)
77027cca
MW
348 ((subtype :initarg :subtype :type c-type :reader c-type-subtype)
349 (dimensions :initarg :dimensions :type list :reader c-array-dimensions))
abdf50aa
MW
350 (:documentation
351 "C array types."))
352
dea4d055
MW
353;; Constructor function.
354
355(export 'make-array-type)
1f1d88f5
MW
356(defun make-array-type (subtype dimensions)
357 "Return a new array of SUBTYPE with given DIMENSIONS."
358 (make-instance 'c-array-type :subtype subtype
359 :dimensions (or dimensions '(nil))))
abdf50aa 360
dea4d055
MW
361;; Comparison protocol.
362
363(defmethod c-type-equal-p and ((type-a c-array-type) (type-b c-array-type))
364
365 ;; Messy. C doesn't have multidimensional arrays, but we fake them for
366 ;; convenience's sake. But it means that we have to arrange for
367 ;; multidimensional arrays to equal vectors of vectors -- and in general
368 ;; for multidimensional arrays of multidimensional arrays to match each
369 ;; other properly, even when their dimensions don't align precisely.
370 (labels ((check (sub-a dim-a sub-b dim-b)
371 (cond ((endp dim-a)
372 (cond ((endp dim-b)
373 (c-type-equal-p sub-a sub-b))
374 ((typep sub-a 'c-array-type)
375 (check (c-type-subtype sub-a)
376 (c-array-dimensions sub-a)
377 sub-b dim-b))
378 (t
379 nil)))
380 ((endp dim-b)
381 (check sub-b dim-b sub-a dim-a))
382 ((equal (car dim-a) (car dim-b))
383 (check sub-a (cdr dim-a) sub-b (cdr dim-b)))
384 (t
385 nil))))
386 (check (c-type-subtype type-a) (c-array-dimensions type-a)
387 (c-type-subtype type-b) (c-array-dimensions type-b))))
388
389;; C syntax output protocol.
390
1f1d88f5
MW
391(defmethod pprint-c-type ((type c-array-type) stream kernel)
392 (pprint-c-type (c-type-subtype type) stream
393 (lambda (stream prio spacep)
394 (maybe-in-parens (stream (> prio 2))
395 (funcall kernel stream 2 spacep)
396 (format stream "~@<~{[~@[~A~]]~^~_~}~:>"
397 (c-array-dimensions type))))))
abdf50aa 398
dea4d055 399;; S-expression notation protocol.
abdf50aa
MW
400
401(defmethod print-c-type (stream (type c-array-type) &optional colon atsign)
402 (declare (ignore colon atsign))
dea4d055 403 (format stream "~:@<[] ~@_~:I~/sod:print-c-type/~{ ~_~S~}~:>"
abdf50aa
MW
404 (c-type-subtype type)
405 (c-array-dimensions type)))
406
dea4d055 407(export '([] array vec))
1f1d88f5 408(define-c-type-syntax [] (sub &rest dims)
abdf50aa
MW
409 "Return the type of arrays of SUB with the dimensions DIMS.
410
411 If the DIMS are omitted, a single unknown-length dimension is added."
1f1d88f5
MW
412 `(make-array-type ,(expand-c-type-spec sub)
413 (list ,@(or dims '(nil)))))
414(c-type-alias [] array vec)
abdf50aa
MW
415
416;;;--------------------------------------------------------------------------
417;;; Function types.
418
dea4d055 419;; Function arguments.
abdf50aa 420
933bbda6 421(defun argument-lists-equal-p (list-a list-b)
1f1d88f5
MW
422 "Return whether LIST-A and LIST-B match.
423
424 They must have the same number of arguments, and each argument must have
3109662a 425 the same type, or be `:ellipsis'. The argument names are not inspected."
abdf50aa
MW
426 (and (= (length list-a) (length list-b))
427 (every (lambda (arg-a arg-b)
428 (if (eq arg-a :ellipsis)
429 (eq arg-b :ellipsis)
b4aab8d4
MW
430 (and (argumentp arg-a) (argumentp arg-b)
431 (c-type-equal-p (argument-type arg-a)
432 (argument-type arg-b)))))
abdf50aa
MW
433 list-a list-b)))
434
dea4d055 435;; Class definition.
1f1d88f5 436
dea4d055 437(export '(c-function-type c-function-arguments))
1f1d88f5 438(defclass c-function-type (c-type)
77027cca 439 ((subtype :initarg :subtype :type c-type :reader c-type-subtype)
8e36de0e 440 (arguments :type list :reader c-function-arguments))
1f1d88f5
MW
441 (:documentation
442 "C function types. The subtype is the return type, as implied by the C
443 syntax for function declarations."))
444
8e36de0e
MW
445(defmethod shared-initialize :after
446 ((type c-function-type) slot-names &key (arguments nil argsp))
447 (declare (ignore slot-names))
448 (when argsp
449 (setf (slot-value type 'arguments)
450 (if (and arguments
451 (null (cdr arguments))
452 (not (eq (car arguments) :ellipsis))
453 (eq (argument-type (car arguments)) c-type-void))
454 nil
455 arguments))))
456
dea4d055
MW
457;; Constructor function.
458
459(export 'make-function-type)
1f1d88f5
MW
460(defun make-function-type (subtype arguments)
461 "Return a new function type, returning SUBTYPE and accepting ARGUMENTS."
4d89d941 462 (make-instance 'c-function-type :subtype subtype
8e36de0e 463 :arguments arguments))
1f1d88f5 464
dea4d055
MW
465;; Comparison protocol.
466
467(defmethod c-type-equal-p and
468 ((type-a c-function-type) (type-b c-function-type))
469 (and (c-type-equal-p (c-type-subtype type-a) (c-type-subtype type-b))
933bbda6
MW
470 (argument-lists-equal-p (c-function-arguments type-a)
471 (c-function-arguments type-b))))
abdf50aa 472
dea4d055 473;; C syntax output protocol.
abdf50aa 474
4d89d941
MW
475(let ((void-arglist (list (make-argument nil c-type-void))))
476 (defmethod pprint-c-type ((type c-function-type) stream kernel)
477 (pprint-c-type (c-type-subtype type) stream
478 (lambda (stream prio spacep)
479 (maybe-in-parens (stream (> prio 2))
480 (when spacep (c-type-space stream))
481 (funcall kernel stream 2 nil)
482 (pprint-indent :block 4 stream)
483 (pprint-logical-block
484 (stream nil :prefix "(" :suffix ")")
485 (let ((firstp t))
486 (dolist (arg (or (c-function-arguments type)
487 void-arglist))
488 (if firstp
489 (setf firstp nil)
490 (format stream ", ~_"))
491 (if (eq arg :ellipsis)
492 (write-string "..." stream)
493 (pprint-c-type (argument-type arg)
494 stream
495 (argument-name arg)))))))))))
1f1d88f5 496
dea4d055
MW
497;; S-expression notation protocol.
498
499(defmethod print-c-type
500 (stream (type c-function-type) &optional colon atsign)
501 (declare (ignore colon atsign))
502 (format stream "~:@<~
503 FUN ~@_~:I~/sod:print-c-type/~
504 ~{ ~_~:<~S ~@_~/sod:print-c-type/~:>~}~
505 ~:>"
506 (c-type-subtype type)
507 (mapcar (lambda (arg)
1224dfb0 508 (if (eq arg :ellipsis) arg
dea4d055
MW
509 (list (argument-name arg) (argument-type arg))))
510 (c-function-arguments type))))
abdf50aa 511
93348ae9 512(export '(fun function () func fn))
1f1d88f5 513(define-c-type-syntax fun (ret &rest args)
abdf50aa
MW
514 "Return the type of functions which returns RET and has arguments ARGS.
515
1f1d88f5
MW
516 The ARGS are a list of arguments of the form (NAME TYPE). The NAME can be
517 NIL to indicate that no name was given.
518
519 If an entry isn't a list, it's assumed to be the start of a Lisp
520 expression to compute the tail of the list; similarly, if the list is
521 improper, then it's considered to be a complete expression. The upshot of
522 this apparently bizarre rule is that you can say
523
524 (c-type (fun int (\"foo\" int) . arg-tail))
525
526 where ARG-TAIL is (almost) any old Lisp expression and have it tack the
527 arguments onto the end. Of course, there don't have to be any explicit
528 arguments at all. The only restriction is that the head of the Lisp form
529 can't be a list -- so ((lambda (...) ...) ...) is out, but you probably
530 wouldn't type that anyway."
531
532 `(make-function-type ,(expand-c-type-spec ret)
533 ,(do ((args args (cdr args))
534 (list nil
535 (cons `(make-argument ,(caar args)
536 ,(expand-c-type-spec
537 (cadar args)))
538 list)))
539 ((or (atom args) (atom (car args)))
540 (cond ((and (null args) (null list)) `nil)
541 ((null args) `(list ,@(nreverse list)))
dea4d055
MW
542 ((and (consp args)
543 (eq (car args) :ellipsis))
544 `(list ,@(nreverse list) :ellipsis))
1f1d88f5
MW
545 ((null list) `,args)
546 (t `(list* ,@(nreverse list) ,args)))))))
547(c-type-alias fun function () func fn)
abdf50aa 548
dea4d055
MW
549;; Additional utilities for dealing with functions.
550
551(export 'commentify-argument-names)
552(defun commentify-argument-names (arguments)
553 "Return an argument list with the arguments commentified.
554
3109662a
MW
555 That is, with each argument name passed through
556 `commentify-argument-name'."
dea4d055 557 (mapcar (lambda (arg)
1224dfb0 558 (if (eq arg :ellipsis) arg
dea4d055
MW
559 (make-argument (commentify-argument-name (argument-name arg))
560 (argument-type arg))))
561 arguments))
562
563(export 'commentify-function-type)
564(defun commentify-function-type (type)
565 "Return a type like TYPE, but with arguments commentified.
566
567 This doesn't recurse into the return type or argument types."
568 (make-function-type (c-type-subtype type)
569 (commentify-argument-names
570 (c-function-arguments type))))
571
abdf50aa 572;;;----- That's all, folks --------------------------------------------------