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