kernel: ?call and simplify

diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor
index e662317cfed25e3854cc79e86a98c8d7d95f7cbd..4deae90e9403aefb9015a9f3bce1a12ac5eeb048 100644 (file)
--- a/core/kernel/kernel-tests.factor
+++ b/core/kernel/kernel-tests.factor
@@ -211,8 +211,8 @@ IN: kernel.tests
 
 { } [ "kernel" reload ] long-unit-test
 
-{ 5 } [ "5" [ string>number ] transmute ] unit-test
-{ "5notanumber" } [ "5notanumber" [ string>number ] transmute ] unit-test
+{ 5 t } [ "5" [ string>number ] call* ] unit-test
+{ "5notanumber" f } [ "5notanumber" [ string>number ] call* ] unit-test
 
-{ 10 } [ 5 [ 2 * ] ?transmute ] unit-test
-{ f } [ f [ 2 * ] ?transmute ] unit-test
+{ 10 } [ 5 [ 2 * ] ?call ] unit-test
+{ f } [ f [ 2 * ] ?call ] unit-test

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index afe28621f92abe78e83b58e2ca64ecef44d17f9a..068fbfd7cbc416653073cc744efd702409eaf48d 100644 (file)
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -103,24 +103,6 @@ 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
-
-: ?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 true: ( ..a cond -- ..b ) false: ( ..a default -- ..b ) -- ..b )
-    [ transmute* ] 2dip if ; inline
-
 ! Dippers.
 ! Not declared inline because the compiler special-cases them
 
@@ -187,6 +169,22 @@ DEFER: if
 : 2keepd ( ..a x y z quot: ( ..a x y z -- ..b ) -- ..b x y )
     3keep drop ; inline
 
+: transmute ( old quot: ( old -- new/f ) -- new/old new? )
+    keep over [ drop t ] [ nip f ] if ; inline
+
+: ?call ( old/f quot -- old'/f ) dupd when ; inline
+
+! Default
+
+: ?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 true: ( ..a cond -- ..b ) false: ( ..a default -- ..b ) -- ..b )
+    [ transmute ] 2dip if ; inline
+
 ! Cleavers
 : bi ( x p q -- )
     [ keep ] dip call ; inline