Deploy tool: if debugger is not stripped out, actually use it to report errors; print an error if vocab has no MAIN: word

basis/debugger/debugger.factor

@@ -70,7 +70,7 @@ M: string error. print ;
     "Type :help for debugging help." print flush ;
 
 : try ( quot -- )
-    [ print-error-and-restarts ] recover ;
+    [ print-error-and-restarts ] recover ; inline
 
 : expired-error. ( obj -- )
     "Object did not survive image save/load: " write third . ;

basis/tools/deploy/backend/backend.factor

@@ -58,25 +58,17 @@ DEFER: ?make-staging-image
 : staging-command-line ( profile -- flags )
     [
         "-staging" ,
-
         dup empty? [
             "-i=" my-boot-image-name append ,
         ] [
             dup but-last ?make-staging-image
-
             "-resource-path=" "" resource-path append ,
-
             "-i=" over but-last staging-image-name append ,
-
             "-run=tools.deploy.restage" ,
         ] if
-
         "-output-image=" over staging-image-name append ,
-
         "-include=" swap " " join append ,
-
         strip-word-names? [ "-no-stack-traces" , ] when
-
         "-no-user-init" ,
     ] { } make ;
 
@@ -101,16 +93,11 @@ DEFER: ?make-staging-image
 
         [
             "-i=" bootstrap-profile staging-image-name append ,
-
             "-resource-path=" "" resource-path append ,
-
             "-run=tools.deploy.shaker" ,
-
             [ "-deploy-vocab=" prepend , ]
             [ make-deploy-config "-deploy-config=" prepend , ] bi
-
             "-output-image=" prepend ,
-
             strip-word-names? [ "-no-stack-traces" , ] when
         ] { } make
     ] bind ;

basis/tools/deploy/deploy-tests.factor

@@ -104,3 +104,8 @@ M: quit-responder call-responder*
     "tools.deploy.test.10" shake-and-bake
     run-temp-image
 ] unit-test
+
+[ ] [
+    "tools.deploy.test.11" shake-and-bake
+    run-temp-image
+] unit-test

basis/tools/deploy/shaker/shaker.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors io.backend io.streams.c init fry
 namespaces make assocs kernel parser lexer strings.parser vocabs
@@ -232,7 +232,6 @@ IN: tools.deploy.shaker
             "tools"
             "io.launcher"
             "random"
-            "compiler"
             "stack-checker"
             "bootstrap"
             "listener"
@@ -241,7 +240,7 @@ IN: tools.deploy.shaker
         strip-dictionary? [
             "libraries" "alien" lookup ,
 
-            { } { "cpu" } strip-vocab-globals %
+            { } { "cpu" "compiler" } strip-vocab-globals %
 
             {
                 gensym
@@ -359,12 +358,26 @@ IN: tools.deploy.shaker
 
 SYMBOL: deploy-vocab
 
-: set-boot-quot* ( word -- )
+: [:c] ( -- word ) ":c" "debugger" lookup ;
+
+: [print-error] ( -- word ) "print-error" "debugger" lookup ;
+
+: deploy-boot-quot ( word -- )
     [
-        \ boot ,
+        [ boot ] %
         init-hooks get values concat %
-        ,
+        strip-debugger? [ , ] [
-        strip-io? [ \ flush , ] unless
+            ! Don't reference try directly
+            [:c]
+            [print-error]
+            '[
+                [ _ execute ] [
+                    _ execute nl
+                    _ execute
+                ] recover
+            ] %
+        ] if
+        strip-io? [ [ flush ] % ] unless
         [ 0 exit ] %
     ] [ ] make
     set-boot-quot ;
@@ -392,7 +405,7 @@ SYMBOL: deploy-vocab
     strip-init-hooks
     strip-c-io
     f 5 setenv ! we can't use the Factor debugger or Factor I/O anymore
-    deploy-vocab get vocab-main set-boot-quot*
+    deploy-vocab get vocab-main deploy-boot-quot
     stripped-word-props
     stripped-globals strip-globals
     compress-byte-arrays
@@ -401,16 +414,33 @@ SYMBOL: deploy-vocab
     compress-wrappers
     strip-words ;
 
+: deploy-error-handler ( quot -- )
+    [
+        strip-debugger?
+        [ error-continuation get call>> callstack>array die ]
+        ! Don't reference these words literally, if we're stripping the
+        ! debugger out we don't want to load the prettyprinter at all
+        [ [:c] nl [print-error] ] if
+        1 exit
+    ] recover ; inline
+
 : (deploy) ( final-image vocab config -- )
     #! Does the actual work of a deployment in the slave
     #! stage2 image
     [
         [
+            strip-debugger? [
+                "debugger" require
+                "inspector" require
+            ] unless
             deploy-vocab set
             deploy-vocab get require
+            deploy-vocab get vocab-main [
+                "Vocabulary has no MAIN: word." print flush 1 exit
+            ] unless
             strip
             finish-deploy
-        ] [ error-continuation get call>> callstack>array die 1 exit ] recover
+        ] deploy-error-handler
     ] bind ;
 
 : do-deploy ( -- )