Changeset 5793

Timestamp:

Jan 25, 2007, 3:37:51 AM (18 years ago)

Author:

Gary Byers

Message:

Never fully understood the concept "auxiliary" foreign types, but try to
canonicalize intermediate struct/union/enum references, so that
(EQ (PARSE-FOREIGN-TYPE '(:STRUCT :FOO))

(PARSE-FOREIGN-TYPE '(:STRUCT :FOO)))

is more likely to return T (e.g., something registered in the FTD.

It seems clear that this is the right thing when the structure reference
is in global scope; I'm not sure what it'd mean for that not to be the
case.

File:

• trunk/ccl/lib/foreign-types.lisp (modified) (2 diffs)

trunk/ccl/lib/foreign-types.lisp

@@ -392 +392 @@
 
 (defun auxiliary-foreign-type (kind name &optional (ftd *target-ftd*))
-  (flet ((aux-defn-matches (x)
-           (and (eq (first x) kind) (eq (second x) name))))
-    (let ((in-auxiliaries
-           (or (find-if #'aux-defn-matches *new-auxiliary-types*)
-               (find-if #'aux-defn-matches *auxiliary-type-definitions*))))
-      (if in-auxiliaries
-          (values (third in-auxiliaries) t)
-          (ecase kind
-            (:struct
-             (info-foreign-type-struct name ftd))
-            (:union
-             (info-foreign-type-union name ftd))
-            (:enum
-             (info-foreign-type-enum name ftd)))))))
-
-(defun %set-auxiliary-foreign-type (kind name defn)
+  (or
+   (ecase kind
+     (:struct
+      (info-foreign-type-struct name ftd))
+     (:union
+      (info-foreign-type-union name ftd))
+     (:enum
+      (info-foreign-type-enum name ftd)))
+   (flet ((aux-defn-matches (x)
+            (and (eq (first x) kind) (eq (second x) name))))
+     (let ((in-auxiliaries
+            (or (find-if #'aux-defn-matches *new-auxiliary-types*)
+                (find-if #'aux-defn-matches *auxiliary-type-definitions*))))
+       (if in-auxiliaries
+         (values (third in-auxiliaries) t))))))
+
+(defun %set-auxiliary-foreign-type (kind name defn &optional (ftd *target-ftd*))
   (flet ((aux-defn-matches (x)
            (and (eq (first x) kind) (eq (second x) name))))
@@ -415 +416 @@
       (error "Attempt to shadow definition of ~A ~S." kind name)))
   (push (list kind name defn) *new-auxiliary-types*)
+  (ecase kind
+    (:struct
+     (setf (info-foreign-type-struct name ftd) defn))
+    (:union
+     (setf (info-foreign-type-union name ftd) defn))
+    (:enum
+     (setf (info-foreign-type-enum name ftd) defn)))
   defn)