kernel: redo ?if to ?if-old, add ?if ?when ?unless

[factor.git] / core / kernel / kernel.factor

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 97e65c95a334d1f60d2189d7c7cda0caca40fcc1..8bd569adba9a57ed2f53efcba002a71cce2ef647 100644 (file)
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -103,10 +103,26 @@ DEFER: if
 : unless* ( ..a ? false: ( ..a -- ..a x ) -- ..a x )
     over [ drop ] [ nip call ] if ; inline
 
+: transmute* ( obj quot: ( obj -- obj/f ) -- new/old changed? )
+    over [ call ] dip over [ drop t ] [ nip f ] if ; inline
+
+: transmute ( obj quot: ( obj -- new/old ) -- new/old ) transmute* drop ; inline
+
+: ?transmute ( obj/f quot -- obj' ) dupd when ; inline
+
 ! Default
-: ?if ( ..a default cond true: ( ..a cond -- ..b ) false: ( ..a default -- ..b ) -- ..b )
+: ?if ( ..a obj cond true: ( ..a cond -- ..b ) false: ( ..a default -- ..b ) -- ..b )
     pick [ drop [ drop ] 2dip call ] [ 2nip call ] if ; inline
 
+: ?when ( ..a obj cond: ( ..a obj -- obj/f ) true: ( ..a cond -- ..b ) -- ..b )
+    [ transmute* ] dip when ; inline
+
+: ?unless ( ..a obj cond: ( ..a obj -- obj/f ) false: ( ..a default -- ..b ) -- ..b )
+    [ transmute* ] dip unless ; inline
+
+: ??if ( ..a obj cond: ( ..a obj -- obj/f ) true: ( ..a cond -- ..b ) false: ( ..a default -- ..b ) -- ..b )
+    [ transmute* ] 2dip if ; inline
+
 ! Dippers.
 ! Not declared inline because the compiler special-cases them