From e4b961a26e95371601199e817ec91df00958150b Mon Sep 17 00:00:00 2001
From: =?utf8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Fri, 18 Nov 2016 18:13:57 +0100
Subject: [PATCH] continuations: new words for ignoring masked errors

it comes from the db.errors vocab but seems to be useful in lots of
situations
---
 basis/db/errors/errors.factor                 |  3 ---
 core/continuations/continuations-docs.factor  | 11 ++++++++++-
 core/continuations/continuations-tests.factor | 11 ++++++++---
 core/continuations/continuations.factor       |  8 ++++++++
 4 files changed, 26 insertions(+), 7 deletions(-)

diff --git a/basis/db/errors/errors.factor b/basis/db/errors/errors.factor
index e35eab1c21..dbb537cedc 100644
--- 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 56da38d46f..b54f6ff6c7 100644
--- 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 6ea528438a..c6acfdda62 100644
--- 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 a3402e7a16..063038a1d7 100644
--- 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
 
-- 
2.34.1