X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/a1985b3cf0ca42f573b8599ec50a0f162a26c314..refs/heads/mdw/progfmt:/src/c-types-proto.lisp

diff --git a/src/c-types-proto.lisp b/src/c-types-proto.lisp
index 43824da..98c6269 100644
--- a/src/c-types-proto.lisp
+++ b/src/c-types-proto.lisp
@@ -46,8 +46,11 @@
 
 (export 'canonify-qualifiers)
 (defun canonify-qualifiers (qualifiers)
-  "Return a canonical list of qualifiers."
-  (delete-duplicates (sort (copy-list qualifiers) #'string<)))
+  "Return a canonical list of qualifiers.
+
+   Duplicates and `nil' entries are deleted, and the remaining entries are
+   sorted."
+  (sort (delete-duplicates (delete nil (copy-list qualifiers))) #'string<))
 
 (export 'qualify-c-type)
 (defgeneric qualify-c-type (type qualifiers)
@@ -175,6 +178,15 @@
   "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.
@@ -192,6 +204,16 @@
 	     (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."
@@ -200,6 +222,7 @@
        ,@(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)))
@@ -212,7 +235,10 @@
    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
@@ -223,6 +249,11 @@
 		     `(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)