From e9a0c96563f45ae2fcfa885cea662d10221801f2 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 26 Aug 2009 17:19:30 -0500
Subject: [PATCH] box elements of struct-arrays when a struct class is used as
 the element type

---
 basis/alien/structs/structs.factor       | 12 +-----------
 basis/classes/struct/struct.factor       | 18 +++++++++---------
 basis/struct-arrays/struct-arrays.factor | 22 ++++++++++++++++++----
 3 files changed, 28 insertions(+), 24 deletions(-)

diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor
index d8b2edf394..3d9cae1202 100755
--- a/basis/alien/structs/structs.factor
+++ b/basis/alien/structs/structs.factor
@@ -3,7 +3,7 @@
 USING: accessors arrays assocs generic hashtables kernel kernel.private
 math namespaces parser sequences strings words libc fry
 alien.c-types alien.structs.fields cpu.architecture math.order
-quotations byte-arrays struct-arrays ;
+quotations byte-arrays ;
 IN: alien.structs
 
 TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
@@ -12,16 +12,6 @@ M: struct-type c-type ;
 
 M: struct-type c-type-stack-align? drop f ;
 
-M: struct-type <c-type-array> ( len c-type -- array )
-    dup c-type-array-constructor
-    [ execute( len -- array ) ]
-    [ <struct-array> ] ?if ; inline
-
-M: struct-type <c-type-direct-array> ( alien len c-type -- array )
-    dup c-type-direct-array-constructor
-    [ execute( alien len -- array ) ]
-    [ <direct-struct-array> ] ?if ; inline
-
 : if-value-struct ( ctype true false -- )
     [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
 
diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index e9de2f7e36..81252656a4 100644
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -1,10 +1,10 @@
 ! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types alien.structs alien.structs.fields arrays
-byte-arrays classes classes.parser classes.tuple
-classes.tuple.parser classes.tuple.private combinators
-combinators.smart fry generalizations generic.parser kernel
-kernel.private lexer libc macros make math math.order parser
-quotations sequences slots slots.private struct-arrays
+USING: accessors alien alien.c-types alien.structs
+alien.structs.fields arrays byte-arrays classes classes.parser
+classes.tuple classes.tuple.parser classes.tuple.private
+combinators combinators.smart fry generalizations generic.parser
+kernel kernel.private lexer libc macros make math math.order
+parser quotations sequences slots slots.private struct-arrays
 vectors words ;
 FROM: slots => reader-word writer-word ;
 IN: classes.struct
@@ -236,9 +236,9 @@ SYNTAX: STRUCT:
 SYNTAX: UNION-STRUCT:
     parse-struct-definition define-union-struct-class ;
 
+SYNTAX: S{
+    scan-word dup struct-slots parse-tuple-literal-slots parsed ;
+
 USING: vocabs vocabs.loader ;
 
 "prettyprint" vocab [ "classes.struct.prettyprint" require ] when
-
-SYNTAX: S{
-    scan-word dup struct-slots parse-tuple-literal-slots parsed ;
diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor
index c0ac29f99b..4243f314d7 100755
--- a/basis/struct-arrays/struct-arrays.factor
+++ b/basis/struct-arrays/struct-arrays.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types byte-arrays kernel libc
-math sequences sequences.private ;
+USING: accessors alien alien.c-types alien.structs byte-arrays
+classes.struct kernel libc math sequences sequences.private ;
 IN: struct-arrays
 
 : c-type-struct-class ( c-type -- class )
@@ -16,11 +16,14 @@ TUPLE: struct-array
 M: struct-array length length>> ;
 M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ;
 
+: (nth-ptr) ( i struct-array -- alien )
+    [ element-size>> * ] [ underlying>> ] bi <displaced-alien> ; inline
+
 M: struct-array nth-unsafe
-    [ element-size>> * ] [ underlying>> ] bi <displaced-alien> ;
+    [ (nth-ptr) ] [ class>> ] bi [ memory>struct ] when* ; inline
 
 M: struct-array set-nth-unsafe
-    [ nth-unsafe swap ] [ element-size>> ] bi memcpy ;
+    [ (nth-ptr) swap ] [ element-size>> ] bi memcpy ;
 
 M: struct-array new-sequence
     [ element-size>> [ * <byte-array> ] 2keep ]
@@ -50,3 +53,14 @@ ERROR: bad-byte-array-length byte-array ;
     [ heap-size calloc ] 2keep <direct-struct-array> ; inline
 
 INSTANCE: struct-array sequence
+
+M: struct-type <c-type-array> ( len c-type -- array )
+    dup c-type-array-constructor
+    [ execute( len -- array ) ]
+    [ <struct-array> ] ?if ; inline
+
+M: struct-type <c-type-direct-array> ( alien len c-type -- array )
+    dup c-type-direct-array-constructor
+    [ execute( alien len -- array ) ]
+    [ <direct-struct-array> ] ?if ; inline
+