Minor improvement to xor word

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 3d210e000007887d042527c3ba7a76553309e972..0a1a3cb7f24b968851410d064960436a3d488846 100755 (executable)
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -437,7 +437,7 @@ HELP: or
 
 HELP: xor
 { $values { "obj1" "a generalized boolean" } { "obj2" "a generalized boolean" } { "?" "a generalized boolean" } }
-{ $description "Tests if at exactly one object is not " { $link f } "." }
+{ $description "If exactly one input is false, outputs the other input. Otherwise outputs " { $link f } "." }
 { $notes "This word implements boolean exclusive or, so applying it to integers will not yield useful results (all integers have a true value). Bitwise exclusive or is the " { $link bitxor } " word." } ;
 
 HELP: both?

diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor
index 195e9becaefd56d8af096eff1a4d2035da9a0fc5..5cb4abc2e9e555905126cb2cc18ca84e5b9626fc 100755 (executable)
--- a/core/kernel/kernel-tests.factor
+++ b/core/kernel/kernel-tests.factor
@@ -50,6 +50,10 @@ IN: kernel.tests
 [ f ] [ 3 f and ] unit-test
 [ 4 ] [ 4 6 or ] unit-test
 [ 6 ] [ f 6 or ] unit-test
+[ f ] [ 1 2 xor ] unit-test
+[ 1 ] [ 1 f xor ] unit-test
+[ 2 ] [ f 2 xor ] unit-test
+[ f ] [ f f xor ] unit-test
 
 [ slip ] must-fail
 [ ] [ :c ] unit-test

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 47e0d76bf71f7b38ce81bd774c560a249b76101d..337fe6c8b029eabf02c124a1518fe2b12af2c358 100755 (executable)
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -173,7 +173,7 @@ GENERIC: boa ( ... class -- tuple )
 
 : or ( obj1 obj2 -- ? ) dupd ? ; inline
 
-: xor ( obj1 obj2 -- ? ) dup not swap ? ; inline
+: xor ( obj1 obj2 -- ? ) [ f swap ? ] when* ; inline
 
 : both? ( x y quot -- ? ) bi@ and ; inline