From 8a2321353bcde9f2c1181cbbc497b0d1d4c2e9ce Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Mon, 31 Aug 2009 05:42:28 -0500
Subject: [PATCH] struct-arrays: hack it up so that if the class name is a
 literal parameter for the constructor, then the array works in deployed apps
 even if not every call site of nth or set-nth is inlined on the array. Fixes
 tools.deploy.test.5 regression after kqueue was converted to use STRUCT:.
 Because of Dan's call(-inlining, no perf regression on struct-arrays
 benchmark!

---
 basis/struct-arrays/struct-arrays.factor | 44 ++++++++++++++++--------
 1 file changed, 29 insertions(+), 15 deletions(-)

diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor
index a3dcd98f0e..73eb356a60 100755
--- a/basis/struct-arrays/struct-arrays.factor
+++ b/basis/struct-arrays/struct-arrays.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.structs byte-arrays
-classes.struct kernel libc math parser sequences sequences.private ;
+classes.struct kernel libc math parser sequences
+sequences.private words fry memoize compiler.units ;
 IN: struct-arrays
 
 : c-type-struct-class ( c-type -- class )
@@ -11,7 +12,8 @@ TUPLE: struct-array
 { underlying c-ptr read-only }
 { length array-capacity read-only }
 { element-size array-capacity read-only }
-{ class read-only } ;
+{ class read-only }
+{ ctor read-only } ;
 
 M: struct-array length length>> ; inline
 M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline
@@ -20,34 +22,46 @@ M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline
     [ element-size>> * >fixnum ] [ underlying>> ] bi <displaced-alien> ; inline
 
 M: struct-array nth-unsafe
-    [ (nth-ptr) ] [ class>> dup struct-class? ] bi [ memory>struct ] [ drop ] if ; inline
+    [ (nth-ptr) ] [ ctor>> ] bi execute( alien -- object ) ; inline
 
 M: struct-array set-nth-unsafe
     [ (nth-ptr) swap ] [ element-size>> ] bi memcpy ; inline
 
+! Foldable memo word. This is an optimization; by precompiling a
+! constructor for array elements, we avoid memory>struct's slow path.
+MEMO: struct-element-constructor ( c-type -- word )
+    [
+        "struct-array-ctor" f <word>
+        [
+            swap dup struct-class?
+            [ '[ _ memory>struct ] [ ] like ] [ drop [ ] ] if
+            (( alien -- object )) define-inline
+        ] keep
+    ] with-compilation-unit ; foldable
+
+: <direct-struct-array> ( alien length c-type -- struct-array )
+    [ heap-size ] [ c-type-struct-class ] [ struct-element-constructor ]
+    tri struct-array boa ; inline
+
 M: struct-array new-sequence
-    [ element-size>> [ * (byte-array) ] 2keep ]
-    [ class>> ] bi struct-array boa ; inline
+    [ element-size>> * (byte-array) ] [ length>> ] [ class>> ] tri
+    <direct-struct-array> ; inline
 
 M: struct-array resize ( n seq -- newseq )
-    [ [ element-size>> * ] [ underlying>> ] bi resize ]
-    [ [ element-size>> ] [ class>> ] bi ] 2bi
-    struct-array boa ;
+    [ [ element-size>> * ] [ underlying>> ] bi resize ] [ class>> ] 2bi
+    <direct-struct-array> ; inline
 
 : <struct-array> ( length c-type -- struct-array )
-    [ heap-size [ * <byte-array> ] 2keep ]
-    [ c-type-struct-class ] bi struct-array boa ; inline
+    [ heap-size * <byte-array> ] 2keep <direct-struct-array> ; 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 ] [ c-type-struct-class ] bi struct-array boa ; inline
-
-: <direct-struct-array> ( alien length c-type -- struct-array )
-    [ heap-size ] [ c-type-struct-class ] bi struct-array boa ; inline
+    ] keep <direct-struct-array> ; inline
 
 : malloc-struct-array ( length c-type -- struct-array )
     [ heap-size calloc ] 2keep <direct-struct-array> ; inline