combinators.extras: make a throws? word that drops properly

mrjbq7 · mrjbq7 · commit f7eafcc14fff · 2025-05-05T10:42:48.000-07:00
diff --git a/extra/combinators/extras/extras-tests.factor b/extra/combinators/extras/extras-tests.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2013 Doug Coleman.
 ! See https://factorcode.org/license.txt for BSD license.
 USING: alien.c-types arrays assocs combinators.extras io.files
-kernel math modern.slices parser ranges sequences splitting
-tools.test ;
+kernel math math.parser modern.slices parser ranges sequences
+splitting tools.test ;
 IN: combinators.extras.tests
 
 
diff --git a/extra/combinators/extras/extras.factor b/extra/combinators/extras/extras.factor
@@ -334,14 +334,17 @@ SYNTAX: ?[ parse-quotation [ ?call ] curry append! ;
 : ?3unless ( ..a x y z pred: ( ..a x quot: ( ..a x y z -- ..b ? ) -- ..b x ? ) false: ( ..b x y z -- ..c ) -- ..c )
     [ ] swap ?3if ; inline
 
+: throws? ( quot -- ? )
+    [ '[ _ drop-outputs f ] ] [ '[ drop _ drop-inputs t ] ] bi recover ; inline
+
 : filter-errors-as ( ... seq quot: ( ... elt -- ... ? ) -- ... subseq )
-    [ '[ [ @ drop f ] [ 2drop t ] recover ] ] dip filter-as ; inline
+    [ '[ _ throws? ] ] dip filter-as ; inline
 
 : filter-errors ( ... seq quot: ( ... elt -- ... ? ) -- ... subseq )
     over filter-errors-as ; inline
 
 : reject-errors-as ( ... seq quot: ( ... elt -- ... ? ) -- ... subseq )
-    [ '[ [ @ drop f ] [ 2drop t ] recover ] ] dip reject-as ; inline
+    [ '[ _ throws? ] ] dip reject-as ; inline
 
 : reject-errors ( ... seq quot: ( ... elt -- ... ? ) -- ... subseq )
     over reject-errors-as ; inline
