"Expands to code to construct a C type, using `expand-c-type-spec'."
(expand-c-type-spec spec))
+(defmethod documentation ((symbol symbol) (doc-type (eql 'c-type)))
+ (let ((method (find-eql-specialized-method #'expand-c-type-spec 0 symbol)))
+ (and method (documentation method t))))
+(defmethod (setf documentation)
+ (string (symbol symbol) (doc-type (eql 'c-type)))
+ (let ((method (find-eql-specialized-method #'expand-c-type-spec 0 symbol)))
+ (unless method (error "No C type spec found with name `~S'." symbol))
+ (setf (documentation method t) string)))
+
(export 'define-c-type-syntax)
(defmacro define-c-type-syntax (name bvl &body body)
"Define a C-type syntax function.
(block ,name ,@body)))
',name))))
+(export 'c-type-form)
+(defmethod documentation ((symbol symbol) (doc-type (eql 'c-type-form)))
+ (let ((method (find-eql-specialized-method #'expand-c-type-form 0 symbol)))
+ (and method (documentation method t))))
+(defmethod (setf documentation)
+ (string (symbol symbol) (doc-type (eql 'c-type-form)))
+ (let ((method (find-eql-specialized-method #'expand-c-type-form 0 symbol)))
+ (unless method (error "No C type spec found with name `~S'." symbol))
+ (setf (documentation method t) string)))
+
(export 'c-type-alias)
(defmacro c-type-alias (original &rest aliases)
"Make ALIASES behave the same way as the ORIGINAL type."
,@(mapcar (lambda (alias)
`(defmethod expand-c-type-form
((,head (eql ',alias)) ,tail)
+ ,(format nil "Alias for `~(~S~)'." original)
(expand-c-type-form ',original ,tail)))
aliases)
',aliases)))
The VALUE is a C type S-expression, acceptable to `expand-c-type-spec'.
It will be expanded once at run-time."
(let* ((names (if (listp names) names (list names)))
- (namevar (gensym "NAME"))
+ (namevar (gensym "NAME-"))
+ (avar (gensym "A"))
+ (tvar (gensym "T"))
+ (svar (gensym "S"))
(typevar (symbolicate 'c-type- (car names))))
`(progn
,@(and export
`(defmethod expand-c-type-spec ((,namevar (eql ',name)))
',typevar))
names))
+ (dolist (,avar '(,@names))
+ (let ((,tvar (format nil "Return a C `~A' type."
+ (with-output-to-string (,svar)
+ (pprint-c-type ,typevar ,svar nil)))))
+ (setf (documentation ,avar 'c-type) ,tvar)))
'names)))
(export 'c-name-case)