From cba071c969bb1b3ad24e9549fc9391879f50bd7d Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 23 Sep 2009 19:41:46 -0500
Subject: [PATCH] don't construct a prototype for struct classes that don't
 need it

---
 basis/classes/struct/struct.factor | 35 +++++++++++++++++++++++-------
 1 file changed, 27 insertions(+), 8 deletions(-)

diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index 7e99328652..63f2ad282e 100755
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -103,6 +103,8 @@ M: struct-class boa>object
     [ <struct> ] [ struct-slots ] bi 
     [ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ;
 
+M: struct-class initial-value* <struct> ; inline
+
 ! Struct slot accessors
 
 GENERIC: struct-slot-values ( struct -- sequence )
@@ -113,6 +115,9 @@ M: struct-class reader-quot
 M: struct-class writer-quot
     nip (writer-quot) ;
 
+: offset-of ( field struct -- offset )
+    struct-slots slot-named offset>> ; inline
+
 ! c-types
 
 TUPLE: struct-c-type < abstract-c-type
@@ -202,15 +207,29 @@ M: struct byte-length class "struct-size" word-prop ; foldable
 ! class definition
 
 <PRIVATE
+GENERIC: binary-zero? ( value -- ? )
+
+M: object binary-zero? drop f ;
+M: f binary-zero? drop t ;
+M: number binary-zero? zero? ;
+M: struct binary-zero?
+    [ byte-length iota ] [ >c-ptr ] bi
+    [ <displaced-alien> *uchar zero? ] curry all? ;
+
+: struct-needs-prototype? ( class -- ? )
+    struct-slots [ initial>> binary-zero? ] all? not ;
+
 : make-struct-prototype ( class -- prototype )
-    [ "struct-size" word-prop <byte-array> ]
-    [ memory>struct ]
-    [ struct-slots ] tri
-    [
-        [ initial>> ]
-        [ (writer-quot) ] bi
-        over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
-    ] each ;
+    dup struct-needs-prototype? [
+        [ "struct-size" word-prop <byte-array> ]
+        [ memory>struct ]
+        [ struct-slots ] tri
+        [
+            [ initial>> ]
+            [ (writer-quot) ] bi
+            over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
+        ] each
+    ] [ drop f ] if ;
 
 : (struct-methods) ( class -- )
     [ (define-struct-slot-values-method) ]