continuations: new words for ignoring masked errors

it comes from the db.errors vocab but seems to be useful in lots of
situations

diff --git a/basis/db/errors/errors.factor b/basis/db/errors/errors.factor
index e35eab1c21b56f3dd7afe6e9c613c930083947a1..dbb537cedcd5ada2b35275d1ff4add9f4aaccce1 100644 (file)
--- a/basis/db/errors/errors.factor
+++ b/basis/db/errors/errors.factor
@@ -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
 

diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor
index 56da38d46f3a817bb694c9d94eb5cd5289f10352..b54f6ff6c7337dd52c2f1df5f146c3a501d5a4b5 100644 (file)
--- a/core/continuations/continuations-docs.factor
+++ b/core/continuations/continuations-docs.factor
@@ -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 } }

diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor
index 6ea528438ab80e189fab5d40dcdc09e405b3c321..c6acfdda62677ced709eca76b590e5477b824abf 100644 (file)
--- a/core/continuations/continuations-tests.factor
+++ b/core/continuations/continuations-tests.factor
@@ -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

diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor
index a3402e7a164411f853e8e9e557a20348eca7fd39..063038a1d791a377121213fa2a808eb94a4c295e 100644 (file)
--- a/core/continuations/continuations.factor
+++ b/core/continuations/continuations.factor
@@ -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