src/c-types-impl.lisp (intern-c-type): Canonify class and initargs.
authorMark Wooding <mdw@distorted.org.uk>
Thu, 26 May 2016 08:26:09 +0000 (09:26 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Fri, 8 Jun 2018 18:58:28 +0000 (19:58 +0100)
Make sure the class and initargs are canonical before probing the
`*c-type-intern-map*'.

  * The class should ideally be represented by name.

  * The initargs should be in ascending order by keyword name.

In particular, this fixes a bug where `qualify-c-type' erroneously
returns a fresh type when asked to attach an empty list of qualifiers to
an already-interned type.

src/c-types-impl.lisp

index a27b30f..9c503b4 100644 (file)
 (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