From c6db662b3b3d58e7036bd46dc4cca40e705f6ae3 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 5 Aug 2008 04:38:01 -0500
Subject: [PATCH] Rice is a part of every healthy diet

---
 basis/tools/deploy/shaker/shaker.factor | 24 ++++++++++++++++++++----
 vm/image.c                              | 18 ++++++++++++++++++
 2 files changed, 38 insertions(+), 4 deletions(-)

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 8713be54bb..7a2aa1c299 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -42,6 +42,7 @@ IN: tools.deploy.shaker
     ] when
     strip-dictionary? [
         "compiler.units" init-hooks get delete-at
+        "tools.vocabs" init-hooks get delete-at
     ] when ;
 
 : strip-debugger ( -- )
@@ -88,16 +89,28 @@ IN: tools.deploy.shaker
     ] [
         "Remaining word properties:" print
         [ props>> keys ] gather .
-    ] bi ;
+    ] [
+        H{ } clone '[
+            [ [ _ [ ] cache ] map ] change-props drop
+        ] each
+    ] tri ;
 
 : stripped-word-props ( -- seq )
     [
+        strip-dictionary? deploy-compiler? get and [
+            {
+                "combination"
+                "members"
+                "methods"
+            } %
+        ] when
+
         strip-dictionary? [
             {
+                "alias"
                 "boa-check"
                 "cannot-infer"
                 "coercer"
-                "combination"
                 "compiled-effect"
                 "compiled-generic-uses"
                 "compiled-uses"
@@ -127,12 +140,10 @@ IN: tools.deploy.shaker
                 "local-writer?"
                 "local?"
                 "macro"
-                "members"
                 "memo-quot"
                 "mixin"
                 "method-class"
                 "method-generic"
-                "methods"
                 "modular-arithmetic"
                 "no-compile"
                 "optimizer-hooks"
@@ -145,6 +156,8 @@ IN: tools.deploy.shaker
                 "reader"
                 "reading"
                 "recursive"
+                "register"
+                "register-size"
                 "shuffle"
                 "slot-names"
                 "slots"
@@ -226,9 +239,12 @@ IN: tools.deploy.shaker
             "alarms"
             "tools"
             "io.launcher"
+            "random"
         } strip-vocab-globals %
 
         strip-dictionary? [
+            "libraries" "alien" lookup ,
+
             { } { "cpu" } strip-vocab-globals %
 
             {
diff --git a/vm/image.c b/vm/image.c
index a0fa48d504..a668cb7913 100755
--- a/vm/image.c
+++ b/vm/image.c
@@ -169,8 +169,26 @@ DEFINE_PRIMITIVE(save_image)
 	save_image(unbox_native_string());
 }
 
+void strip_compiled_quotations(void)
+{
+	begin_scan();
+	CELL obj;
+	while((obj = next_object()) != F)
+	{
+		if(type_of(obj) == QUOTATION_TYPE)
+		{
+			F_QUOTATION *quot = untag_object(obj);
+			quot->compiledp = F;
+		}
+	}
+	gc_off = false;
+}
+
 DEFINE_PRIMITIVE(save_image_and_exit)
 {
+	/* This reduces deployed image size */
+	strip_compiled_quotations();
+
 	F_CHAR *path = unbox_native_string();
 
 	REGISTER_C_STRING(path);