From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 24 Feb 2023 22:49:13 +0000 (-0600)
Subject: kernel: ?call and simplify
X-Git-Tag: 0.99~525
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=954aa04d7d494f9af887d795ac5e30b9b30cdfc9

kernel: ?call and simplify
---

diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor
index e662317cfe..4deae90e94 100644
--- 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 afe28621f9..068fbfd7cb 100644
--- 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