From 23f34febbbbe57d5508416eacd5fefefe0f847ae Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Mon, 31 Aug 2009 16:34:58 -0500
Subject: [PATCH] Fix image size regression with struct array tree shaking

---
 basis/struct-arrays/struct-arrays.factor            | 11 +++++++----
 basis/tools/deploy/shaker/shaker.factor             | 12 +++++++++---
 .../tools/deploy/shaker/strip-struct-arrays.factor  | 13 +++++++++++++
 3 files changed, 29 insertions(+), 7 deletions(-)
 create mode 100644 basis/tools/deploy/shaker/strip-struct-arrays.factor

diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor
index 73eb356a60..38dab33f0e 100755
--- a/basis/struct-arrays/struct-arrays.factor
+++ b/basis/struct-arrays/struct-arrays.factor
@@ -27,9 +27,7 @@ M: struct-array nth-unsafe
 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-element-constructor) ( c-type -- word )
     [
         "struct-array-ctor" f <word>
         [
@@ -37,7 +35,12 @@ MEMO: struct-element-constructor ( c-type -- word )
             [ '[ _ memory>struct ] [ ] like ] [ drop [ ] ] if
             (( alien -- object )) define-inline
         ] keep
-    ] with-compilation-unit ; foldable
+    ] with-compilation-unit ;
+
+! 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-element-constructor) ; foldable
 
 : <direct-struct-array> ( alien length c-type -- struct-array )
     [ heap-size ] [ c-type-struct-class ] [ struct-element-constructor ]
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 6a133d9c87..2244eb9249 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -68,9 +68,14 @@ IN: tools.deploy.shaker
     ] when ;
 
 : strip-destructors ( -- )
-    "libc" vocab [
-        "Stripping destructor debug code" show
-        "vocab:tools/deploy/shaker/strip-destructors.factor"
+    "Stripping destructor debug code" show
+    "vocab:tools/deploy/shaker/strip-destructors.factor"
+    run-file ;
+
+: strip-struct-arrays ( -- )
+    "struct-arrays" vocab [
+        "Stripping dynamic struct array code" show
+        "vocab:tools/deploy/shaker/strip-struct-arrays.factor"
         run-file
     ] when ;
 
@@ -493,6 +498,7 @@ SYMBOL: deploy-vocab
 : strip ( -- )
     init-stripper
     strip-libc
+    strip-struct-arrays
     strip-destructors
     strip-call
     strip-cocoa
diff --git a/basis/tools/deploy/shaker/strip-struct-arrays.factor b/basis/tools/deploy/shaker/strip-struct-arrays.factor
new file mode 100644
index 0000000000..55b6630082
--- /dev/null
+++ b/basis/tools/deploy/shaker/strip-struct-arrays.factor
@@ -0,0 +1,13 @@
+USING: kernel stack-checker.transforms ;
+IN: struct-arrays
+
+: struct-element-constructor ( c-type -- word )
+    "Struct array usages must be compiled" throw ;
+
+<<
+
+\ struct-element-constructor [
+    (struct-element-constructor) [ ] curry
+] 1 define-transform
+
+>>
\ No newline at end of file