tools.deploy.shaker: tweak error reporting slightly

basis/tools/deploy/shaker/shaker.factor

@@ -1,13 +1,15 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays alien.libraries accessors io.backend io.encodings.utf8 io.files
-io.streams.c init fry namespaces math make assocs kernel parser
-parser.notes lexer strings.parser vocabs sequences sequences.deep
-sequences.private words memory kernel.private continuations io
-vocabs.loader system strings sets vectors quotations byte-arrays
-sorting compiler.units definitions generic generic.standard
-generic.single tools.deploy.config combinators classes vocabs.loader.private
-classes.builtin slots.private grouping command-line io.pathnames ;
+USING: arrays alien.libraries accessors io.backend
+io.encodings.utf8 io.files io.streams.c init fry namespaces math
+make assocs kernel parser parser.notes lexer strings.parser
+vocabs sequences sequences.deep sequences.private words memory
+kernel.private continuations io vocabs.loader system strings
+sets vectors quotations byte-arrays sorting compiler.units
+definitions generic generic.standard generic.single
+tools.deploy.config combinators combinators.private classes
+vocabs.loader.private classes.builtin slots.private grouping
+command-line io.pathnames ;
 QUALIFIED: bootstrap.stage2
 QUALIFIED: classes.private
 QUALIFIED: compiler.crossref
@@ -548,10 +550,18 @@ SYMBOL: deploy-vocab
     strip-words
     clear-megamorphic-caches ;
 
+: die-with ( error original-error -- * )
+    #! We don't want DCE to drop the error before the die call!
+    [ die 1 exit ] (( a -- * )) call-effect-unsafe ;
+
+: die-with2 ( error original-error -- * )
+    #! We don't want DCE to drop the error before the die call!
+    [ die 1 exit ] (( a b -- * )) call-effect-unsafe ;
+
 : deploy-error-handler ( quot -- )
     [
         strip-debugger?
-        [ error-continuation get call>> callstack>array die 1 exit ]
+        [ original-error get die-with2 ]
         ! Don't reference these words literally, if we're stripping the
         ! debugger out we don't want to load the prettyprinter at all
         [ [:c] execute( -- ) nl [print-error] execute( error -- ) flush ] if

basis/tools/deploy/shaker/strip-debugger.factor

@@ -1,17 +1,13 @@
 USING: compiler.units words vocabs kernel threads.private ;
 IN: debugger
 
-: consume ( error -- )
-    #! We don't want DCE to drop the error before the die call!
-    drop ;
+: error. ( error -- ) original-error get die-with2 ;
 
-: print-error ( error -- ) die consume ;
-
-: error. ( error -- ) die consume ;
+: print-error ( error -- ) error. ;
 
 "threads" vocab [
     [
         "error-in-thread" "threads" lookup
-        [ [ die 2drop ] define ] [ f "combination" set-word-prop ] bi
+        [ [ drop error. ] define ] [ f "combination" set-word-prop ] bi
     ] with-compilation-unit
 ] when