continuations: new words for ignoring masked errors
it comes from the db.errors vocab but seems to be useful in lots of situationschar-rename
parent
19616c9714
commit
e4b961a26e
|
@ -48,9 +48,6 @@ TUPLE: sql-index-exists < sql-error name ;
|
|||
: <sql-index-exists> ( name -- error )
|
||||
f swap sql-index-exists boa ;
|
||||
|
||||
: ignore-error ( quot check: ( error -- ? ) -- )
|
||||
'[ dup @ [ drop ] [ rethrow ] if ] recover ; inline
|
||||
|
||||
: ignore-table-exists ( quot -- )
|
||||
[ sql-table-exists? ] ignore-error ; inline
|
||||
|
||||
|
|
|
@ -179,9 +179,18 @@ HELP: recover
|
|||
{ $values { "try" { $quotation ( ..a -- ..b ) } } { "recovery" { $quotation ( ..a error -- ..b ) } } }
|
||||
{ $description "Calls the " { $snippet "try" } " quotation. If an exception is thrown in the dynamic extent of the " { $snippet "try" } " quotation, restores the data stack and calls the " { $snippet "recovery" } " quotation to handle the error." } ;
|
||||
|
||||
HELP: ignore-error
|
||||
{ $values { "quot" quotation } { "check" quotation } }
|
||||
{ $description "Calls the quotation. If an exception is thrown which is matched by the 'check' quotation it is ignored. Otherwise the error is rethrown." } ;
|
||||
|
||||
HELP: ignore-error/f
|
||||
{ $values { "quot" quotation } { "check" quotation } }
|
||||
{ $description "Like " { $link ignore-error } ", but if a matched exception is thrown " { $link f } " is put on the stack." } ;
|
||||
|
||||
HELP: ignore-errors
|
||||
{ $values { "quot" quotation } }
|
||||
{ $description "Calls the quotation. If an exception is thrown in the dynamic extent of the quotation, restores the data stack and returns." } ;
|
||||
{ $description "Calls the quotation. If an exception is thrown in the dynamic extent of the quotation, restores the data stack and returns." }
|
||||
{ $notes "For safer alternatives to this word see " { $link ignore-error } " and " { $link ignore-error/f } "." } ;
|
||||
|
||||
HELP: in-callback?
|
||||
{ $values { "?" boolean } }
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USING: accessors continuations debugger eval io kernel
|
||||
kernel.private math memory namespaces sequences tools.test
|
||||
vectors words ;
|
||||
USING: accessors continuations debugger eval io kernel kernel.private
|
||||
math math.ratios memory namespaces sequences tools.test vectors words
|
||||
;
|
||||
IN: continuations.tests
|
||||
|
||||
: (callcc1-test) ( n obj -- n' obj )
|
||||
|
@ -33,6 +33,11 @@ IN: continuations.tests
|
|||
"Hello" =
|
||||
] unit-test
|
||||
|
||||
{ 4 f } [
|
||||
[ 20 5 / ] [ division-by-zero? ] ignore-error/f
|
||||
[ 20 0 / ] [ division-by-zero? ] ignore-error/f
|
||||
] unit-test
|
||||
|
||||
"!!! The following error is part of the test" print
|
||||
|
||||
{ } [ [ 6 [ 12 [ "2 car" ] ] ] print-error ] unit-test
|
||||
|
|
|
@ -151,6 +151,14 @@ callback-error-hook [ [ die rethrow ] ] initialize
|
|||
: ignore-errors ( quot -- )
|
||||
[ drop ] recover ; inline
|
||||
|
||||
: ignore-error ( quot check: ( error -- ? ) -- )
|
||||
[ dup ] prepose [ [ drop ] [ rethrow ] if ] compose
|
||||
recover ; inline
|
||||
|
||||
: ignore-error/f ( quot check: ( error -- ? ) -- )
|
||||
[ dup ] prepose [ [ drop f ] [ rethrow ] if ] compose
|
||||
recover ; inline
|
||||
|
||||
: cleanup ( try cleanup-always cleanup-error -- )
|
||||
[ compose [ dip rethrow ] curry recover ] [ drop ] 2bi call ; inline
|
||||
|
||||
|
|
Loading…
Reference in New Issue