store struct class in struct-array

diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor
index 60b9af0f191e884ce968c6eaf234245b81db9f65..c0ac29f99b0ccb2b2a986348658a4469d026bd0d 100755 (executable)
--- a/basis/struct-arrays/struct-arrays.factor
+++ b/basis/struct-arrays/struct-arrays.factor
@@ -4,10 +4,14 @@ USING: accessors alien alien.c-types byte-arrays kernel libc
 math sequences sequences.private ;
 IN: struct-arrays
 
+: c-type-struct-class ( c-type -- class )
+    c-type boxed-class>> ; foldable
+
 TUPLE: struct-array
 { underlying c-ptr read-only }
 { length array-capacity read-only }
-{ element-size array-capacity read-only } ;
+{ element-size array-capacity read-only }
+{ class read-only } ;
 
 M: struct-array length length>> ;
 M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ;
@@ -19,25 +23,28 @@ M: struct-array set-nth-unsafe
     [ nth-unsafe swap ] [ element-size>> ] bi memcpy ;
 
 M: struct-array new-sequence
-    element-size>> [ * <byte-array> ] 2keep struct-array boa ; inline
+    [ element-size>> [ * <byte-array> ] 2keep ]
+    [ class>> ] bi struct-array boa ; inline
 
 M: struct-array resize ( n seq -- newseq )
-    [ [ element-size>> * ] [ underlying>> ] bi resize ] [ element-size>> ] 2bi
+    [ [ element-size>> * ] [ underlying>> ] bi resize ]
+    [ [ element-size>> ] [ class>> ] bi ] 2bi
     struct-array boa ;
 
 : <struct-array> ( length c-type -- struct-array )
-    heap-size [ * <byte-array> ] 2keep struct-array boa ; inline
+    [ heap-size [ * <byte-array> ] 2keep ]
+    [ c-type-struct-class ] bi struct-array boa ; inline
 
 ERROR: bad-byte-array-length byte-array ;
 
 : byte-array>struct-array ( byte-array c-type -- struct-array )
-    heap-size [
+    [ heap-size [
         [ dup length ] dip /mod 0 =
         [ drop bad-byte-array-length ] unless
-    ] keep struct-array boa ; inline
+    ] keep ] [ c-type-struct-class ] bi struct-array boa ; inline
 
 : <direct-struct-array> ( alien length c-type -- struct-array )
-    heap-size struct-array boa ; inline
+    [ heap-size ] [ c-type-struct-class ] bi struct-array boa ; inline
 
 : malloc-struct-array ( length c-type -- struct-array )
     [ heap-size calloc ] 2keep <direct-struct-array> ; inline