(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