Changeset 6043 for branches

Timestamp:

Mar 15, 2007, 12:53:48 AM (18 years ago)

Author:

Gary Byers

Message:

Intern foreign-array-types, too.

File:

• branches/objc-gf/ccl/lib/foreign-types.lisp (modified) (2 diffs)

branches/objc-gf/ccl/lib/foreign-types.lisp

@@ -71 +71 @@
   (ordinal-lock (make-lock))
   (ordinal-types (make-hash-table :test #'eq :weak :key))
-  (pointer-types (make-hash-table :test #'equalp)))
+  (pointer-types (make-hash-table :test #'equalp))
+  (array-types (make-hash-table :test #'equalp)))
 
 
@@ -1711 +1712 @@
             (error "Dimension is not a non-negative fixnum: ~S" loser))))
         
-      (let ((type (parse-foreign-type ele-type)))
-        (make-foreign-array-type
-         :element-type type
-         :dimensions dims
-         :alignment (foreign-type-alignment type)
-         :bits (if (and (ensure-foreign-type-bits type)
-                        (every #'integerp dims))
-                 (* (align-offset (foreign-type-bits type)
-                                  (foreign-type-alignment type))
-                    (reduce #'* dims))))))
+      (let* ((type (parse-foreign-type ele-type))
+            (pair (cons type dims)))
+        (declare (dynamic-extent pair))
+        (or (gethash pair (ftd-array-types *target-ftd*))
+            (setf (gethash (cons type dims) (ftd-array-types *target-ftd*))
+                  
+                  (make-foreign-array-type
+                   :element-type type
+                   :dimensions dims
+                   :alignment (foreign-type-alignment type)
+                   :bits (if (and (ensure-foreign-type-bits type)
+                                  (every #'integerp dims))
+                           (* (align-offset (foreign-type-bits type)
+                                            (foreign-type-alignment type))
+                              (reduce #'* dims))))))))
     (def-foreign-type-translator * (to)
       (let* ((to (if (eq to t) *void-foreign-type* (parse-foreign-type to))))