steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

tools.deploy.shaker: tweak error reporting slightly

db4
Slava Pestov 2010-05-03 23:07:46 -04:00
parent 86d89f3ff7
commit 41ec3f20a8
2 changed files with 22 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
basis/tools/deploy/shaker/shaker.factor
View File

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

10
basis/tools/deploy/shaker/strip-debugger.factor
View File

@ -1,17 +1,13 @@
USING: compiler.units words vocabs kernel threads.private ; USING: compiler.units words vocabs kernel threads.private ;
IN: debugger IN: debugger
: consume ( error -- ) : error. ( error -- ) original-error get die-with2 ;
#! We don't want DCE to drop the error before the die call!
drop ;
: print-error ( error -- ) die consume ; : print-error ( error -- ) error. ;
: error. ( error -- ) die consume ;
"threads" vocab [ "threads" vocab [
[ [
"error-in-thread" "threads" lookup "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 ] with-compilation-unit
] when ] when