X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/fbd5be649c2cddfdcf0557bf7321b1d1bbaa39e4..8db2259b25024c83cda8a1d0869b282d115983d7:/doc/list-exports.lisp

diff --git a/doc/list-exports.lisp b/doc/list-exports.lisp
index 8ef80b8..c86156b 100755
--- a/doc/list-exports.lisp
+++ b/doc/list-exports.lisp
@@ -37,13 +37,30 @@
     (and export
 	 (list* (symbolicate code '-inst)
 		(symbolicate 'make- code '-inst)
-		(mapcan (lambda (arg)
-			  (let ((sym (if (listp arg) (car arg) arg)))
-			    (cond ((char= (char (symbol-name sym) 0) #\&)
-				   nil)
-				  (t
-				   (list (symbolicate 'inst- sym))))))
-			args)))))
+		(labels ((dig (tree path)
+			   (if (or (atom tree) (null path)) tree
+			       (dig (nth (car path) tree) (cdr path))))
+			 (cook (arg)
+			   (if (consp arg) (car arg)
+			       (let ((name (symbol-name arg)))
+				 (if (char= (char name 0) #\%)
+				     (intern (subseq name 1))
+				     arg))))
+			 (instify (arg)
+			   (symbolicate 'inst- (cook arg))))
+		  (loop with state = :mandatory
+			for arg in args
+			if (and (symbolp arg)
+				(char= (char (symbol-name arg) 0) #\&))
+			  do (setf state arg)
+			else if (member state '(:mandatory &rest))
+			  collect (instify arg)
+			else if (member state '(&optional &aux))
+			  collect (instify (dig arg '(0)))
+			else if (eq state '&key)
+			  collect (instify (dig arg '(0 1)))
+			else
+			  do (error "Confused by ~S." arg)))))))
 
 (defmethod form-list-exports ((head (eql 'sod::define-tagged-type)) tail)
   (destructuring-bind (kind what) tail