Merge branch 'master' of git://factorcode.org/git/factor

[factor.git] / basis / inverse / inverse.factor

diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor
index 2183c95f080db60145007c7016d888ea7188d3a5..39a2d5f3dc96f0f0b01de3f8535cf95f1bd5b02a 100755 (executable)
--- a/basis/inverse/inverse.factor
+++ b/basis/inverse/inverse.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2009 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel words summary slots quotations
+USING: accessors kernel locals words summary slots quotations
 sequences assocs math arrays stack-checker effects
 continuations debugger classes.tuple namespaces make vectors
 bit-arrays byte-arrays strings sbufs math.functions macros
@@ -231,6 +231,18 @@ DEFER: __
 \ output>sequence 2 [ [undo] '[ dup _ assure-same-class _ input<sequence ] ] define-pop-inverse
 \ input<sequence 1 [ [undo] '[ _ { } output>sequence ] ] define-pop-inverse
 
+! conditionals
+
+:: undo-if-empty ( result a b -- seq )
+   a call( -- b ) result = [ { } ] [ result b [undo] call( a -- b ) ] if ;
+
+:: undo-if* ( result a b -- boolean )
+   b call( -- b ) result = [ f ] [ result a [undo] call( a -- b ) ] if ;
+
+\ if-empty 2 [ swap [ undo-if-empty ] 2curry ] define-pop-inverse
+
+\ if* 2 [ swap [ undo-if* ] 2curry ] define-pop-inverse
+
 ! Constructor inverse
 : deconstruct-pred ( class -- quot )
     "predicate" word-prop [ dupd call assure ] curry ;
@@ -283,4 +295,4 @@ M: no-match summary drop "Fall through in switch" ;
     reverse [ [ [undo] ] dip compose ] { } assoc>map
     recover-chain ;
 
-MACRO: switch ( quot-alist -- ) [switch] ;
+MACRO: switch ( quot-alist -- ) [switch] ;
\ No newline at end of file