(defun intern-c-type (class &rest initargs)
"If the CLASS and INITARGS have already been interned, then return the
existing object; otherwise make a new one."
- (let ((list (cons class initargs)))
+ (let ((list (cons (typecase class
+ ;; Canonify the class object; we'd prefer a name.
+ (standard-class (class-name class))
+ (t class))
+ (let ((alist nil) (plist initargs))
+ ;; Canonify the initargs. Arrange for them to be in
+ ;; ascending order by name. This is annoying because
+ ;; a plist isn't a readily sortable sequence.
+ (loop
+ (when (null plist) (return))
+ (let ((name (pop plist)) (value (pop plist)))
+ (push (cons name value) alist)))
+ (dolist (assoc (sort alist #'string> :key #'car))
+ (push (cdr assoc) plist)
+ (push (car assoc) plist))
+ plist))))
(or (gethash list *c-type-intern-map*)
(let ((new (apply #'make-instance class initargs)))
(setf (gethash new *c-type-intern-map*) t